Tue Mar 9 15:54:55 CST 2010 wasserman.louis@gmail.com
* Priority queues for containers
Tue Mar 9 15:55:17 CST 2010 wasserman.louis@gmail.com
* Pairing queues for containers
New patches:
[Priority queues for containers
wasserman.louis@gmail.com**20100309215455
Ignorethis: f653aaa1e6587a5836431bc2f05a9bec
] {
adddir ./Data/PQueue
addfile ./Data/PQueue/Max.hs
hunk ./Data/PQueue/Max.hs 1
+{# LANGUAGE CPP #}
hunk ./Data/PQueue/Max.hs 3
+
+ 
+ Module : Data.PQueue.Max
+ Copyright : (c) Louis Wasserman 2010
+ License : BSDstyle
+ Maintainer : libraries@haskell.org
+ Stability : experimental
+ Portability : portable
+
+ General purpose priority queue, supporting extractmaximum operations.
+
+ An amortized running time is given for each operation, with /n/ referring
+ to the length of the sequence and /i/ being the integral index used by
+ some operations. These bounds hold even in a persistent (shared) setting.
+
+ This implementation is based on a binomial heap augmented with a global root.
+ The spine of the heap is maintained strictly, ensuring that computations happen
+ as they are performed. Note that this module is a small wrapper around
+ "Data.PQueue.Min".
+
+ /WARNING:/ 'toList' and 'toDescList' are /not/ equivalent, unlike for example
+ "Data.Map".
+
+module Data.PQueue.Max(
+ MaxQueue,
+  * Basic operations
+ empty,
+ null,
+ size,
+  * Query operations
+ top,
+ delete,
+ extract,
+  * Construction operations
+ singleton,
+ insert,
+ union,
+ unions,
+  * Extracting elements
+ (!!),
+ take,
+ drop,
+ splitAt,
+ takeWhile,
+ dropWhile,
+ span,
+ break,
+ filter,
+ partition,
+  * Fold\/Functor\/Traversable variations
+ mapMonotonic,
+ foldrDesc,
+ foldlDesc,
+ traverseMonotonic,
+  * List operations
+ toList,
+ toDescList,
+ fromList,
+ fromDescList) where
+
+import Control.Applicative (Applicative(..), (<$>))
+
+import Data.Monoid
+import Data.Foldable hiding (toList)
+import Data.Traversable
+import Data.Ord
+
+import qualified Data.PQueue.Min as Min
+
+import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter)
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts (build)
+import Text.Read (Lexeme(Ident), lexP, parens, prec,
+ readPrec, readListPrec, readListPrecDefault)
+#endif
+
+  A priority queue implementation. Implemented as a wrapper around "Data.PQueue.Min".
+ /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/.
+ For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid
+ 'MaxQueue' will return a valid 'MaxQueue'. An analogous guarantee holds for 'traverse'. (Note:
+ if passed constanttime operations, every function in 'Functor', 'Foldable', and 'Traversable'
+ will run in /O(n)/.)
+
+ If you wish to perform folds on a priority queue that respect order, use 'foldrDesc' or
+ 'foldlDesc'.
+newtype MaxQueue a = MaxQ {unMaxQ :: Min.MinQueue (Down a)}
+newtype Down a = Down {unDown :: a} deriving (Eq)
+
+instance Ord a => Ord (Down a) where
+ Down x `compare` Down y = compare y x
+ Down x <= Down y = y <= x
+ Down x < Down y = y < x
+ Down x >= Down y = y >= x
+ Down x > Down y = y > x
+
+instance Ord a => Eq (MaxQueue a) where
+ MaxQ q1 == MaxQ q2 = q1 == q2
+
+instance Ord a => Ord (MaxQueue a) where
+ MaxQ q1 `compare` MaxQ q2 = q1 `compare` q2
+
+instance (Ord a, Show a) => Show (MaxQueue a) where
+ showsPrec p xs = showParen (p > 10) $
+ showString "fromDescList " . shows (toDescList xs)
+
+instance Read a => Read (MaxQueue a) where
+#ifdef __GLASGOW_HASKELL__
+ readPrec = parens $ prec 10 $ do
+ Ident "fromDescList" < lexP
+ xs < readPrec
+ return (fromDescList xs)
+
+ readListPrec = readListPrecDefault
+#else
+ readsPrec p = readParen (p > 10) $ \ r > do
+ ("fromDescList",s) < lex r
+ (xs,t) < reads s
+ return (fromDescList xs,t)
+#endif
+
+instance Ord a => Monoid (MaxQueue a) where
+ mempty = empty
+ mappend = union
+
+  /O(1)/. The empty priority queue.
+empty :: MaxQueue a
+empty = MaxQ Min.empty
+
+  /O(1)/. Is this the empty priority queue?
+null :: MaxQueue a > Bool
+null (MaxQ q) = Min.null q
+
+  /O(1)/. The number of elements in the queue.
+size :: MaxQueue a > Int
+size (MaxQ q) = Min.size q
+
+  /O(log n)/. The top (maximum) element of the queue, if there is one.
+top :: Ord a => MaxQueue a > Maybe a
+top = fmap fst . extract
+
+  /O(log n)/. Extract the top (maximum) element of the sequence, if there is one.
+extract :: Ord a => MaxQueue a > Maybe (a, MaxQueue a)
+extract (MaxQ q) = case Min.extract q of
+ Nothing > Nothing
+ Just (Down x, q')
+ > Just (x, MaxQ q')
+
+  /O(log n)/. Delete the top (maximum) element of the sequence, if there is one.
+delete :: Ord a => MaxQueue a > Maybe (MaxQueue a)
+delete = fmap snd . extract
+
+  /O(1)/. Construct a priority queue with a single element.
+singleton :: a > MaxQueue a
+singleton = MaxQ . Min.singleton . Down
+
+  /O(1)/. Insert an element into the priority queue.
+insert :: Ord a => a > MaxQueue a > MaxQueue a
+insert x (MaxQ q) = MaxQ (Min.insert (Down x) q)
+
+  /O(log (min(n,m)))/. Take the union of two priority queues.
+union :: Ord a => MaxQueue a > MaxQueue a > MaxQueue a
+MaxQ q1 `union` MaxQ q2 = MaxQ (Min.union q1 q2)
+
+  Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@.
+unions :: Ord a => [MaxQueue a] > MaxQueue a
+unions = foldl union empty
+
+  /O(k log n)/. Returns the @(k+1)@th largest element of the queue.
+(!!) :: Ord a => MaxQueue a > Int > a
+MaxQ q !! n = unDown ((Min.!!) q n)
+
+{# INLINE take #}
+  /O(k log n)/. Returns the list of the @k@ largest elements of the queue, in descending order, or
+ all elements of the queue, if @k >= n@.
+take :: Ord a => Int > MaxQueue a > [a]
+take k (MaxQ q) = [a  Down a < Min.take k q]
+
+  /O(k log n)/. Returns the queue with the @k@ largest elements deleted, or the empty queue if @k >= n@.
+drop :: Ord a => Int > MaxQueue a > MaxQueue a
+drop k (MaxQ q) = MaxQ (Min.drop k q)
+
+  /O(k log n)/. Equivalent to @(take k queue, drop k queue)@.
+splitAt :: Ord a => Int > MaxQueue a > ([a], MaxQueue a)
+splitAt k (MaxQ q) = (map unDown xs, MaxQ q') where
+ (xs, q') = Min.splitAt k q
+
+  'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the
+ longest prefix (possibly empty) of @queue@ of elements that satisfy @p@.
+takeWhile :: Ord a => (a > Bool) > MaxQueue a > [a]
+takeWhile p (MaxQ q) = map unDown (Min.takeWhile (p . unDown) q)
+
+  'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.
+
+dropWhile :: Ord a => (a > Bool) > MaxQueue a > MaxQueue a
+dropWhile p (MaxQ q) = MaxQ (Min.dropWhile (p . unDown) q)
+
+  'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where
+ first element is longest prefix (possibly empty) of @queue@ of elements that
+ satisfy @p@ and second element is the remainder of the queue.
+
+span :: Ord a => (a > Bool) > MaxQueue a > ([a], MaxQueue a)
+span p (MaxQ q) = (map unDown xs, MaxQ q') where
+ (xs, q') = Min.span (p . unDown) q
+
+  'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where
+ first element is longest prefix (possibly empty) of @queue@ of elements that
+ /do not satisfy/ @p@ and second element is the remainder of the queue.
+break :: Ord a => (a > Bool) > MaxQueue a > ([a], MaxQueue a)
+break p = span (not . p)
+
+filter :: Ord a => (a > Bool) > MaxQueue a > MaxQueue a
+filter p (MaxQ q) = MaxQ (Min.filter (p . unDown) q)
+
+partition :: Ord a => (a > Bool) > MaxQueue a > (MaxQueue a, MaxQueue a)
+partition p (MaxQ q) = (MaxQ q0, MaxQ q1)
+ where (q0, q1) = Min.partition (p . unDown) q
+
+  /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
+ as in 'fmap'. If it is not, the result is undefined.
+mapMonotonic :: (a > b) > MaxQueue a > MaxQueue b
+mapMonotonic = fmap
+
+  /O(n)/. Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.
+ If the function is not monotonic, the result is undefined.
+traverseMonotonic :: Applicative f => (a > f b) > MaxQueue a > f (MaxQueue b)
+traverseMonotonic = traverse
+
+instance Functor Down where
+ fmap f (Down a) = Down (f a)
+
+instance Foldable Down where
+ foldr f z (Down a) = a `f` z
+ foldl f z (Down a) = z `f` a
+
+instance Traversable Down where
+ traverse f (Down a) = Down <$> f a
+
+instance Functor MaxQueue where
+ fmap f (MaxQ q) = MaxQ (fmap (fmap f) q)
+
+instance Foldable MaxQueue where
+ foldr f z (MaxQ q) = foldr (flip (foldr f)) z q
+ foldl f z (MaxQ q) = foldl (foldl f) z q
+
+instance Traversable MaxQueue where
+ traverse f (MaxQ q) = MaxQ <$> traverse (traverse f) q
+
+  /O(n log n)/. Performs a rightfold on the elements of a priority queue in descending order.
+foldrDesc :: Ord a => (a > b > b) > b > MaxQueue a > b
+foldrDesc f z (MaxQ q) = Min.foldrAsc (flip (foldr f)) z q
+
+  /O(n log n)/. Performs a leftfold on the elements of a priority queue in descending order.
+foldlDesc :: Ord a => (b > a > b) > b > MaxQueue a > b
+foldlDesc f z (MaxQ q) = Min.foldlAsc (foldl f) z q
+
+{# INLINE toDescList #}
+  /O(n log n)/. Extracts the elements of the priority queue in descending order.
+toDescList :: Ord a => MaxQueue a > [a]
+#ifdef __GLASGOW_HASKELL__
+toDescList q = build (\ c nil > foldrDesc c nil q)
+#else
+toDescList = foldrDesc (:) []
+#endif
+
+{# INLINE toList #}
+  /O(n)/. Returns the elements of the priority queue in no particular order.
+toList :: MaxQueue a > [a]
+#ifdef __GLASGOW_HASKELL__
+toList q = build (\ c nil > foldr c nil q)
+#else
+toList = foldr (:) []
+#endif
+
+{# INLINE fromDescList #}
+  /O(n)/. Constructs a priority queue from an descending list. /Warning/: Does not check the precondition.
+fromDescList :: [a] > MaxQueue a
+fromDescList = MaxQ . Min.fromAscList . map Down
+
+{# INLINE fromList #}
+  /O(n log n)/. Constructs a priority queue from an unordered list.
+fromList :: Ord a => [a] > MaxQueue a
+fromList = foldr insert empty
addfile ./Data/PQueue/Min.hs
hunk ./Data/PQueue/Min.hs 1
+{# LANGUAGE CPP #}
hunk ./Data/PQueue/Min.hs 3
+
+ 
+ Module : Data.PQueue.Min
+ Copyright : (c) Louis Wasserman 2010
+ License : BSDstyle
+ Maintainer : libraries@haskell.org
+ Stability : experimental
+ Portability : portable
+
+ General purpose priority queue, supporting extractminimum operations.
+
+ An amortized running time is given for each operation, with /n/ referring
+ to the length of the sequence and /i/ being the integral index used by
+ some operations. These bounds hold even in a persistent (shared) setting.
+
+ This implementation is based on a binomial heap augmented with a global root.
+ The spine of the heap is maintained strictly, ensuring that computations happen
+ as they are performed.
+
+ /WARNING:/ 'toList' and 'toAscList' are /not/ equivalent, unlike for example
+ "Data.Map".
+
+module Data.PQueue.Min (
+ MinQueue,
+  * Basic operations
+ empty,
+ null,
+ size,
+  * Query operations
+ top,
+ delete,
+ extract,
+  * Construction operations
+ singleton,
+ insert,
+ union,
+ unions,
+  * Extracting elements
+ (!!),
+ take,
+ drop,
+ splitAt,
+ takeWhile,
+ dropWhile,
+ span,
+ break,
+ filter,
+ partition,
+  * Fold\/Functor\/Traversable variations
+ mapMonotonic,
+ foldrAsc,
+ foldlAsc,
+ traverseMonotonic,
+  * List operations
+ toList,
+ toAscList,
+ fromList,
+ fromAscList) where
+
+import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter)
+
+import Control.Applicative (Applicative(..), (<$>))
+
+import Data.Monoid
+import Data.Foldable hiding (toList)
+import Data.Traversable
+
+import qualified Data.List as List
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts (build)
+import Text.Read (Lexeme(Ident), lexP, parens, prec,
+ readPrec, readListPrec, readListPrecDefault)
+#else
+
+build :: ((a > [a] > [a]) > [a] > [a]) > [a]
+build f = f (:) []
+
+#endif
+
+  A priority queue implementation. Implemented as a findmin wrapper around a binomial heap.
+ /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/.
+ For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid
+ 'MinQueue' will return a valid 'MinQueue'. An analogous guarantee holds for 'traverse'. (Note:
+ if passed constanttime operations, every function in 'Functor', 'Foldable', and 'Traversable'
+ will run in /O(n)/.)
+
+ If you wish to perform folds on a priority queue that respect order, use 'foldrAsc' or
+ 'foldlAsc'.
+
+ For any operation @op@ in 'Eq' or 'Ord', @queue1 `op` queue2@ is equivalent to
+ @toAscList queue1 `op` toAscList queue2@.
+data MinQueue a = Empty  MinQueue {# UNPACK #} !Int a !(BinomHeap a)
+type BinomHeap a = BinomForest a Zero
+
+instance Ord a => Eq (MinQueue a) where
+ Empty == Empty = True
+ MinQueue n1 x1 q1 == MinQueue n2 x2 q2
+ = n1 == n2 && x1 == x2 && foldr (&&) True
+ (zipWith (==) (heapToList q1) (heapToList q2))
+ _ == _ = False
+
+instance Ord a => Ord (MinQueue a) where
+ Empty `compare` Empty = EQ
+ Empty `compare` _ = LT
+ _ `compare` Empty = GT
+ MinQueue n1 x1 q1 `compare` MinQueue n2 x2 q2 =
+ compare x1 x2 `mappend` foldr mappend (compare n1 n2) (zipWith compare (heapToList q1) (heapToList q1))
+  We compare their first elements, then their other elements up to the smaller queue's length,
+  and then the longer queue wins.
+  This is equivalent to @comparing toAscList@, except it fuses much more nicely.
+
+heapToList :: Ord a => BinomHeap a > [a]
+heapToList q = build (\ c nil > foldrUnfold c nil extractHeap q)
+
+instance (Ord a, Show a) => Show (MinQueue a) where
+ showsPrec p xs = showParen (p > 10) $
+ showString "fromAscList " . shows (toAscList xs)
+
+instance Read a => Read (MinQueue a) where
+#ifdef __GLASGOW_HASKELL__
+ readPrec = parens $ prec 10 $ do
+ Ident "fromAscList" < lexP
+ xs < readPrec
+ return (fromAscList xs)
+
+ readListPrec = readListPrecDefault
+#else
+ readsPrec p = readParen (p > 10) $ \ r > do
+ ("fromAscList",s) < lex r
+ (xs,t) < reads s
+ return (fromAscList xs,t)
+#endif
+
+instance Ord a => Monoid (MinQueue a) where
+ mempty = Empty
+ mappend = union
+ mconcat = unions
+
+ We implement tree ranks in the type system with a nicely elegant approach, as follows.
+ The goal is to have the type system automatically guarantee that our binomial forest
+ has the correct binomial structure.
+
+ In the traditional settheoretic construction of the natural numbers, we define
+ each number to be the set of numbers less than it, and zero to be the empty set,
+ as follows:
+
+ 0 = {} 1 = {0} 2 = {0, 1} 3={0, 1, 2} ...
+
+ Binomial trees have a similar structure: a tree of rank @k@ has one child of each
+ rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer
+ to a collection of binomial trees of ranks @0..k1@. Then we can say that
+
+ > data Succ e rk = Succ (BinomTree e rk) rk
+
+ and this behaves exactly as the successor operator for ranks should behave. Furthermore,
+ we immediately obtain that
+
+ > data BinomTree e rk = BinomTree e rk
+
+ which is nice and compact.
+data BinomForest e rk = Nil  Skip !(BinomForest' e rk)  Cons {# UNPACK #} !(BinomTree e rk) !(BinomForest' e rk)
+type BinomForest' e rk = BinomForest e (Succ e rk)
+
+data BinomTree e rk = BinomTree e rk
+type BinomTree' e rk = BinomTree e (Succ e rk)
+data Succ e rk = Succ {# UNPACK #} !(BinomTree e rk) rk
+type Zero = ()
+
+ basics
+
+  /O(1)/. The empty priority queue.
+empty :: MinQueue a
+empty = Empty
+
+  /O(1)/. Is this the empty priority queue?
+null :: MinQueue a > Bool
+null Empty = True
+null _ = False
+
+  /O(1)/. The number of elements in the queue.
+size :: MinQueue a > Int
+size Empty = 0
+size (MinQueue n _ _) = n
+
+ queries
+  /O(1)/. View the top (minimum) element of the queue, if there is one.
+top :: Ord a => MinQueue a > Maybe a
+top = fmap fst . extract
+
+  /O(log n)/. Delete the top element of the sequence, if there is one.
+delete :: Ord a => MinQueue a > Maybe (MinQueue a)
+delete = fmap snd . extract
+
+  /O(log n)/. Extract the top (minimum) element of the sequence, if there is one.
+extract :: Ord a => MinQueue a > Maybe (a, MinQueue a)
+extract Empty = Nothing
+extract (MinQueue n x ts) = Just (x, case extractBin (<=) ts of
+ NoExtract > Empty
+ YesExtract x' _ ts' > MinQueue (n1) x' ts')
+
+  /O(1)/. Construct a priority queue with a single element.
+singleton :: a > MinQueue a
+singleton x = MinQueue 1 x Nil
+
+  /O(1)/. Insert an element into the priority queue.
+insert :: Ord a => a > MinQueue a > MinQueue a
+insert x' (MinQueue n x f)
+  x' <= x = MinQueue (n+1) x' (insertBin x f)
+  otherwise = MinQueue (n+1) x (insertBin x' f)
+ where insertBin = carry1 (<=) . tip
+insert x Empty = singleton x
+
+  /O(log (min(n,m)))/. Take the union of two priority queues.
+union :: Ord a => MinQueue a > MinQueue a > MinQueue a
+union = union' (<=)
+
+  Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@.
+unions :: Ord a => [MinQueue a] > MinQueue a
+unions = foldl union Empty
+
+  Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest element in the queue.
+(!!) :: Ord a => MinQueue a > Int > a
+q !! n  n >= size q
+ = error "Data.PQueue.Min.!!: index too large"
+q !! n = (List.!!) (toAscList q) n
+
+{# INLINE takeWhile #}
+  'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the
+ longest prefix (possibly empty) of @queue@ of elements that satisfy @p@.
+takeWhile :: Ord a => (a > Bool) > MinQueue a > [a]
+takeWhile p queue = foldWhileFB p (toAscList queue)
+
+{# INLINE foldWhileFB #}
+foldWhileFB :: (a > Bool) > [a] > [a]
+foldWhileFB p xs = build (\ c nil > let
+ consWhile x xs
+  p x = x `c` xs
+  otherwise = nil
+ in foldr consWhile nil xs)
+
+  'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.
+dropWhile :: Ord a => (a > Bool) > MinQueue a > MinQueue a
+dropWhile p = drop' where
+ drop' q = case extract q of
+ Just (x, q')
+  p x > drop' q'
+ _ > q
+
+  'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where
+ first element is longest prefix (possibly empty) of @queue@ of elements that
+ satisfy @p@ and second element is the remainder of the queue.
+span :: Ord a => (a > Bool) > MinQueue a > ([a], MinQueue a)
+span p queue = case extract queue of
+ Just (x, q')  p x
+ > let (ys, q'') = span p q' in (x:ys, q'')
+ _ > ([], queue)
+
+  'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where
+ first element is longest prefix (possibly empty) of @queue@ of elements that
+ /do not satisfy/ @p@ and second element is the remainder of the queue.
+break :: Ord a => (a > Bool) > MinQueue a > ([a], MinQueue a)
+break p = span (not . p)
+
+{# INLINE take #}
+  /O(k log n)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
+ or all elements of @queue@ itself if @k >= 'size' queue@.
+take :: Ord a => Int > MinQueue a > [a]
+take n = List.take n . toAscList
+
+  /O(k log n)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
+ or an empty queue if @k >= size 'queue'@.
+drop :: Ord a => Int > MinQueue a > MinQueue a
+drop n queue = n `seq` case delete queue of
+ Just queue'
+  n > 0 > drop (n1) queue'
+ _ > queue
+
+  /O(k log n)/. Equivalent to @('take' k queue, 'drop' k queue)@.
+splitAt :: Ord a => Int > MinQueue a > ([a], MinQueue a)
+splitAt n queue = n `seq` case extract queue of
+ Just (x, queue')
+  n > 0 > let (xs, queue'') = splitAt (n1) queue' in (x:xs, queue'')
+ _ > ([], queue)
+
+  /O(n)/. Returns the queue with all elements not satisfying @p@ removed.
+filter :: Ord a => (a > Bool) > MinQueue a > MinQueue a
+filter _ Empty = Empty
+filter p (MinQueue _ x ts) = if p x then insertMinQ x q' else q'
+ where q' = filterQueue p (<=) (const Empty) Empty ts
+
+partition :: Ord a => (a > Bool) > MinQueue a > (MinQueue a, MinQueue a)
+partition _ Empty = (Empty, Empty)
+partition p (MinQueue _ x ts) = case partitionQueue p (<=) (const (Empty, Empty)) (Empty, Empty) ts of
+ (q0, q1)  p x > (insertMinQ x q0, q1)
+  otherwise > (q0, insertMinQ x q1)
+
+  /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
+ as in 'fmap'. If it is not, the result is undefined.
+mapMonotonic :: (a > b) > MinQueue a > MinQueue b
+mapMonotonic = fmap
+
+  /O(n)/. Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.
+ If the function is not monotonic, the result is undefined.
+traverseMonotonic :: Applicative f => (a > f b) > MinQueue a > f (MinQueue b)
+traverseMonotonic = traverse
+
+{# INLINE toAscList #}
+  /O(n log n)/. Extracts the elements of the priority queue in ascending order.
+toAscList :: Ord a => MinQueue a > [a]
+toAscList queue = build (\ c nil > foldrAsc c nil queue)
+
+{# INLINE toList #}
+  /O(n)/. Returns the elements of the priority queue in no particular order.
+toList :: MinQueue a > [a]
+toList q = build (\ c nil > foldr c nil q)
+
+{# INLINE foldrAsc #}
+  /O(n log n)/. Performs a rightfold on the elements of a priority queue in ascending order.
+foldrAsc :: Ord a => (a > b > b) > b > MinQueue a > b
+foldrAsc f z q = case q of
+ Empty > z
+ MinQueue _ x ts > x `f` foldrUnfold f z extractHeap ts
+
+{# INLINE foldrUnfold #}
+foldrUnfold :: (a > c > c) > c > (b > Maybe (a, b)) > b > c
+foldrUnfold c nil suc s0 = unf s0 where
+ unf x = case suc x of
+ Nothing > nil
+ Just (a, x') > a `c` unf x'
+
+  /O(n log n)/. Performs a leftfold on the elements of a priority queue in ascending order.
+foldlAsc :: Ord a => (b > a > b) > b > MinQueue a > b
+foldlAsc f z q = case extract q of
+ Nothing > z
+ Just (x, q') > foldlAsc f (z `f` x) q'
+
+{# INLINE fromList #}
+  /O(n)/. Constructs a priority queue from an unordered list.
+fromList :: Ord a => [a] > MinQueue a
+fromList = foldr insert Empty
+
+{# INLINE fromAscList #}
+  /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.
+fromAscList :: [a] > MinQueue a
+fromAscList = foldr insertMinQ Empty
+
+{# INLINE union' #}
+union' :: (a > a > Bool) > MinQueue a > MinQueue a > MinQueue a
+union' _ Empty q = q
+union' _ q Empty = q
+union' (<=) (MinQueue n1 x1 f1) (MinQueue n2 x2 f2)
+  x1 <= x2 = MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2)
+  otherwise = MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2)
+
+  Takes a size and a binomial forest and produces a priority queue with a distinguished global root.
+extractHeap :: Ord a => BinomHeap a > Maybe (a, BinomHeap a)
+extractHeap ts = case extractBin (<=) ts of
+ NoExtract > Nothing
+ YesExtract x _ ts'
+ > Just (x, ts')
+
+  A specialized type intended to organize the return of extractmin queries
+ from a binomial forest. We walk all the way through the forest, and then
+ walk backwards. @Extract e rk@ is the result type of an extractmin
+ operation that has walked as far backwards of rank @rk@  that is, it
+ has visited every root of rank @>= rk@.
+
+ The interpretation of @YesExtract minKey children forest@ is
+
+ * @minKey@ is the key of the minimum root visited so far. It may have
+ any rank @>= rk@. We will denote the root corresponding to
+ @minKey@ as @minRoot@.
+
+ * @children@ is those children of @minRoot@ which have not yet been
+ merged with the rest of the forest. Specifically, these are
+ the children with rank @< rk@.
+
+ * @forest@ is an accumulating parameter that maintains the partial
+ reconstruction of the binomial forest without @minRoot@. It is
+ the union of all old roots with rank @>= rk@ (except @minRoot@),
+ with the set of all children of @minRoot@ with rank @>= rk@.
+ Note that @forest@ is lazy, so if we discover a smaller key
+ than @minKey@ later, we haven't wasted significant work.
+data Extract e rk = NoExtract  YesExtract e rk (BinomForest e rk)
+
+  Walks backward from the biggest key in the forest, as far as rank @rk@.
+ Returns its progress. Each successive application of @extractBin@ takes
+ amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.
+extractBin :: (e > e > Bool) > BinomForest e rk > Extract e rk
+extractBin _ Nil = NoExtract
+extractBin (<=) (Skip f) = case extractBin (<=) f of
+ NoExtract > NoExtract
+ YesExtract minKey (Succ kChild kChildren) f' >
+ YesExtract minKey kChildren (Cons kChild f')
+extractBin (<=) (Cons t@(BinomTree x ts) f) = case extractBin (<=) f of
+ YesExtract minKey (Succ kChild kChildren) f'
+  minKey < x > YesExtract minKey kChildren (Skip (carry1 (<=) (t `cat` kChild) f'))
+ _ > YesExtract x ts (Skip f)
+ where cat = joinBin (<=)
+ a < b = not (b <= a)
+
+filterQueue :: (a > Bool) > (a > a > Bool) > (rk > MinQueue a) > MinQueue a > BinomForest a rk > MinQueue a
+filterQueue p (<=) fCh q0 forest = q0 `seq` case forest of
+ Nil > q0
+ Skip forest' > filterQueue p (<=) fCh' q0 forest'
+ Cons t forest' > filterQueue p (<=) fCh' (union' (<=) (filterT t) q0) forest'
+ where fCh' (Succ t tss) = union' (<=) (filterT t) (fCh tss)
+ filterT (BinomTree x ts)
+  p x = insertMinQ x (fCh ts)
+  otherwise = fCh ts
+
+type Partition a = (MinQueue a, MinQueue a)
+
+partitionQueue :: (a > Bool) > (a > a > Bool) > (rk > Partition a) > Partition a >
+ BinomForest a rk > Partition a
+partitionQueue p (<=) fCh (q0, q1) forest = q0 `seq` q1 `seq` case forest of
+ Nil > (q0, q1)
+ Skip forest' > partitionQueue p (<=) fCh' (q0, q1) forest'
+ Cons t forest' > partitionQueue p (<=) fCh' (both (union' (<=)) (partitionT t) (q0, q1)) forest'
+ where both f (x1, x2) (y1, y2) = (f x1 y1, f x2 y2)
+ fCh' (Succ t tss) = both (union' (<=)) (partitionT t) (fCh tss)
+ partitionT (BinomTree x ts) = case fCh ts of
+ (q0, q1)
+  p x > (insertMinQ x q0, q1)
+  otherwise > (q0, insertMinQ x q1)
+
+{# INLINE tip #}
+  Constructs a binomial tree of rank 0.
+tip :: e > BinomTree e ()
+tip x = BinomTree x ()
+
+  Given two binomial forests starting at rank @rk@, takes their union.
+ Each successive application of this function costs /O(1)/, so applying it
+ from the beginning costs /O(log n)/.
+merge :: (e > e > Bool) > BinomForest e rk > BinomForest e rk > BinomForest e rk
+merge (<=) f1 f2 = case (f1, f2) of
+ (Nil, _) > f2
+ (_, Nil) > f1
+ (Skip f1', Skip f2')
+ > Skip (merge (<=) f1' f2')
+ (Skip f1', Cons t2 f2')
+ > Cons t2 (merge (<=) f1' f2')
+ (Cons t1 f1', Skip f2')
+ > Cons t1 (merge (<=) f1' f2')
+ (Cons t1 f1', Cons t2 f2')
+ > Skip (carry (<=) (t1 `cat` t2) f1' f2')
+ where cat = joinBin (<=)
+
+  Merges two binomial forests with another tree. If we are thinking of the trees
+ in the binomial forest as binary digits, this corresponds to a carry operation.
+ Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.
+carry :: (e > e > Bool) > BinomTree e rk > BinomForest e rk > BinomForest e rk > BinomForest e rk
+carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of
+ (Nil, Nil) > Cons t0 Nil
+ (Nil, Skip f2') > Cons t0 f2'
+ (Skip f1', Nil) > Cons t0 f1'
+ (Nil, Cons t2 f2') > Skip (carry1 (<=) (t0 `cat` t2) f2')
+ (Cons t1 f1', Nil) > Skip (carry1 (<=) (t0 `cat` t1) f1')
+ (Skip f1', Skip f2') > Cons t0 (merge (<=) f1' f2')
+ (Skip f1', Cons t2 f2') > Skip (mergeCarry t0 t2 f1' f2')
+ (Cons t1 f1', Skip f2') > Skip (mergeCarry t0 t1 f1' f2')
+ (Cons t1 f1', Cons t2 f2')
+ > Cons t0 (mergeCarry t1 t2 f1' f2')
+ where cat = joinBin (<=)
+ mergeCarry tA tB f1 f2 = carry (<=) (tA `cat` tB) f1 f2
+
+  Merges a binomial tree into a binomial forest. If we are thinking
+ of the trees in the binomial forest as binary digits, this corresponds
+ to adding a power of 2. This costs amortized /O(1)/ time.
+carry1 :: (e > e > Bool) > BinomTree e rk > BinomForest e rk > BinomForest e rk
+carry1 (<=) t f = t `seq` case f of
+ Nil > Cons t Nil
+ Skip f > Cons t f
+ Cons t' f' > Skip (carry1 (<=) (t `cat` t') f')
+ where cat = joinBin (<=)
+
+  The carrying operation: takes two binomial heaps of the same rank @k@
+ and returns one of rank @k+1@. Takes /O(1)/ time.
+joinBin :: (e > e > Bool) > BinomTree e rk > BinomTree e rk > BinomTree' e rk
+joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2)
+  x1 <= x2 = BinomTree x1 (Succ t2 ts1)
+  otherwise = BinomTree x2 (Succ t1 ts2)
+
+instance Functor MinQueue where
+ fmap _ Empty = Empty
+ fmap f (MinQueue n x forest) = MinQueue n (f x) (fmap2 f (const ()) forest)
+
+class Bifunctor f where
+ fmap2 :: (x > x') > (y > y') > f x y > f x' y'
+
+instance Bifunctor BinomForest where
+ fmap2 f g ts = case ts of
+ Nil > Nil
+ Skip ts' > Skip (fmap2 f g' ts')
+ Cons t ts' > Cons (fmap2 f g t) (fmap2 f g' ts')
+ where g' = fmap2 f g
+
+instance Bifunctor BinomTree where
+ fmap2 f g (BinomTree x ts) = BinomTree (f x) (g ts)
+
+instance Bifunctor Succ where
+ fmap2 f g (Succ t ts) = Succ (fmap2 f g t) (g ts)
+
+instance Foldable MinQueue where
+ foldr _ z Empty = z
+ foldr f z (MinQueue _ x ts) = x `f` foldr2 f (const id) z ts
+ foldl _ z Empty = z
+ foldl f z (MinQueue _ x ts) = foldl2 f const (z `f` x) ts
+ foldl1 f Empty = error "Error: foldl1 called on an empty queue"
+ foldl1 f (MinQueue _ x ts) = foldl2 f const x ts
+
+class Bifoldable f where
+ foldr2 :: (a > c > c) > (b > c > c) > c > f a b > c
+ foldl2 :: (c > a > c) > (c > b > c) > c > f a b > c
+
+instance Bifoldable BinomForest where
+ foldr2 f g z ts = case ts of
+ Nil > z
+ Skip ts' > foldr2 f g' z ts'
+ Cons t ts' > foldr2 f g (foldr2 f g' z ts') t
+ where g' = flip (foldr2 f g)
+ foldl2 f g z ts = case ts of
+ Nil > z
+ Skip ts' > foldl2 f g' z ts'
+ Cons t ts' > foldl2 f g' (foldl2 f g z t) ts'
+ where g' = foldl2 f g
+
+instance Bifoldable BinomTree where
+ foldr2 f g z (BinomTree x ts) = x `f` (ts `g` z)
+ foldl2 f g z (BinomTree x ts) = z `f` x `g` ts
+
+instance Bifoldable Succ where
+ foldr2 f g z (Succ t ts) = foldr2 f g (ts `g` z) t
+ foldl2 f g z (Succ t ts) = foldl2 f g z t `g` ts
+
+instance Traversable MinQueue where
+ traverse _ Empty = pure Empty
+ traverse f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse2 f (const (pure ())) ts
+
+class Bitraversable t where
+ traverse2 :: Applicative f => (a > f a') > (b > f b') >
+ t a b > f (t a' b')
+
+instance Bitraversable BinomForest where
+ traverse2 f g ts = case ts of
+ Nil > pure Nil
+ Skip ts' > Skip <$> traverse2 f g' ts'
+ Cons t ts' > Cons <$> traverse2 f g t <*> traverse2 f g' ts'
+ where g' = traverse2 f g
+
+instance Bitraversable BinomTree where
+ traverse2 f g (BinomTree x ts) = BinomTree <$> f x <*> g ts
+
+instance Bitraversable Succ where
+ traverse2 f g (Succ t ts) = Succ <$> traverse2 f g t <*> g ts
+
+insertMinQ :: a > MinQueue a > MinQueue a
+insertMinQ x Empty = singleton x
+insertMinQ x (MinQueue n x' f) = MinQueue (n+1) x (insertMin (tip x') f)
+
+  @insertMin t f@ assumes that the root of @t@ compares as less than
+ every other root in @f@, and merges accordingly.
+insertMin :: BinomTree e rk > BinomForest e rk > BinomForest e rk
+insertMin t Nil = Cons t Nil
+insertMin t (Skip f) = Cons t f
+insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f)
hunk ./containers.cabal 36
Data.Graph
Data.Sequence
Data.Tree
+ Data.PQueue.Min
+ Data.PQueue.Max
+ Data.PQueue
}
if impl(ghc) {
extensions: DeriveDataTypeable, MagicHash, Rank2Types
}
[Pairing queues for containers
wasserman.louis@gmail.com**20100309215517
Ignorethis: a6590ad2ef6609ca45ead31548efbf3c
] {
addfile ./Data/PQueue/Pairing.hs
hunk ./Data/PQueue/Pairing.hs 1

+{# LANGUAGE CPP #}
+
+
+ 
+ Module : Data.PQueue.Pairing
+ Copyright : (c) Louis Wasserman 2010
+ License : BSDstyle
+ Maintainer : libraries@haskell.org
+ Stability : experimental
+ Portability : portable
+
+ Generalpurpose priority queue implementation built on a minpairingheap.
+
+ This implementation is extremely speedy, especially when used in a singlethreaded
+ fashion. However, the amortized bounds are only valid in a singlethreaded context,
+ and the worstcase performance of deleteMin is /O(n)/. However, when used in
+ a singlethreaded context, this can be twice as fast as the binomial heap implementation.
+
+
+module Data.PQueue.Pairing (
+ PQueue,
+  * Basic operations
+ empty,
+ null,
+ size,
+  * Query operations
+ top,
+ delete,
+ extract,
+  * Construction operations
+ singleton,
+ insert,
+ union,
+ unions,
+ intersection,
+ difference,
+  * Extracting elements
+ (!!),
+ take,
+ drop,
+ splitAt,
+ takeWhile,
+ dropWhile,
+ span,
+ break,
+  * Fold\/Functor\/Traversable variations
+ mapMonotonic,
+ foldrAsc,
+ foldlAsc,
+ traverseMonotonic,
+  * Filter
+ filter,
+ partition,
+  * List operations
+ toList,
+ toAscList,
+ fromList,
+ fromAscList) where
+
+import Control.Applicative hiding (empty)
+
+import Data.Maybe
+import Data.Monoid
+import Data.Foldable hiding (toList, foldl')
+import Data.Traversable
+
+import qualified Data.List as List
+
+import Prelude hiding (null, foldr, foldl, foldl1, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!),
+ filter)
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts (build)
+import Text.Read (Lexeme(Ident), lexP, parens, prec,
+ readPrec, readListPrec, readListPrecDefault)
+#else
+
+build :: ((a > [a] > [a]) > [a] > [a]) > [a]
+build f = f (:) []
+
+#endif
+
+data PQueue a = Empty  PairQ {# UNPACK #} !Int {# UNPACK #} !(PHeap a)
+data PHeap a = PHeap a (PChildren a)
+data PChildren a = Zero  One {# UNPACK #} !(PHeap a)  Two {# UNPACK #} !(PHeap a) {# UNPACK #} !(PHeap a)
+
+instance Ord a => Eq (PQueue a) where
+ Empty == Empty = True
+ PairQ n1 t1 == PairQ n2 t2 = n1 == n2 && foldr (&&) True (zipWith (==) (heapToList t1) (heapToList t2))
+  This is a compromise between unrolling the entire thing by hand, and allocating unnecessary
+  lists.
+ _ == _ = False
+
+instance Ord a => Ord (PQueue a) where
+ compare Empty Empty = EQ
+ compare Empty PairQ{} = LT
+ compare PairQ{} Empty = GT
+ compare (PairQ n1 t1) (PairQ n2 t2)
+ = foldr mappend (compare n1 n2) (zipWith compare (heapToList t1) (heapToList t2))
+  This is a compromise between unrolling the entire thing by hand, and allocating unnecessary
+  lists.
+
+heapToList :: Ord a => PHeap a > [a]
+heapToList t = build (\ c nil > foldrAscH (<=) c nil t)
+
+instance Ord a => Monoid (PQueue a) where
+ mempty = empty
+ mappend = union
+ mconcat = unions
+
+instance (Ord a, Show a) => Show (PQueue a) where
+ showsPrec p xs = showParen (p > 10) $
+ showString "fromAscList " . shows (toAscList xs)
+
+instance Read a => Read (PQueue a) where
+#ifdef __GLASGOW_HASKELL__
+ readPrec = parens $ prec 10 $ do
+ Ident "fromAscList" < lexP
+ xs < readPrec
+ return (fromAscList xs)
+
+ readListPrec = readListPrecDefault
+#else
+ readsPrec p = readParen (p > 10) $ \ r > do
+ ("fromAscList",s) < lex r
+ (xs,t) < reads s
+ return (fromAscList xs,t)
+#endif
+
+instance Functor PHeap where
+ fmap f (PHeap x ts) = PHeap (f x) (fmap f ts)
+
+instance Functor PChildren where
+ fmap _ Zero = Zero
+ fmap f (One t) = One (fmap f t)
+ fmap f (Two t1 t2) = Two (fmap f t1) (fmap f t2)
+
+instance Functor PQueue where
+ fmap _ Empty = Empty
+ fmap f (PairQ n t) = PairQ n (fmap f t)
+
+instance Foldable PHeap where
+ foldr f z (PHeap x ts) = x `f` foldr f z ts
+ foldl f z (PHeap x ts) = foldl f (z `f` x) ts
+ foldl1 f (PHeap x ts) = foldl f x ts
+
+instance Foldable PChildren where
+ foldr f z ts = case ts of
+ Zero > z
+ One t > foldr f z t
+ Two t1 t2 > foldr f (foldr f z t2) t1
+
+instance Foldable PQueue where
+ foldr _ z Empty = z
+ foldr f z (PairQ _ t) = foldr f z t
+ foldl _ z Empty = z
+ foldl f z (PairQ _ t) = foldl f z t
+ foldl1 f (PairQ _ t) = foldl1 f t
+ foldl1 _ _ = error "Error: foldl1 called on empty queue"
+
+instance Traversable PHeap where
+ traverse f (PHeap x t) = PHeap <$> f x <*> traverse f t
+
+instance Traversable PChildren where
+ traverse f ts = case ts of
+ Zero > pure Zero
+ One t > One <$> traverse f t
+ Two t1 t2 > Two <$> traverse f t1 <*> traverse f t2
+
+instance Traversable PQueue where
+ traverse _ Empty = pure Empty
+ traverse f (PairQ n t) = PairQ n <$> traverse f t
+
+  /O(1)/. The empty priority queue.
+empty :: PQueue a
+empty = Empty
+
+  /O(1)/. Is this the empty priority queue?
+null :: PQueue a > Bool
+null Empty = True
+null _ = False
+
+  /O(1)/. The number of elements in the queue.
+size :: PQueue a > Int
+size Empty = 0
+size (PairQ n _) = n
+
+  /O(1)/. Construct a priority queue with a single element.
+singleton :: a > PQueue a
+singleton = PairQ 1 . tip
+
+  /O(1)/. Insert an element into the priority queue.
+insert :: Ord a => a > PQueue a > PQueue a
+insert x Empty = singleton x
+insert x (PairQ n q) = PairQ (n+1) (meldHeap (<=) (tip x) q)
+
+  /O(1)/. Take the union of two priority queues.
+union :: Ord a => PQueue a > PQueue a > PQueue a
+Empty `union` q = q
+q `union` Empty = q
+PairQ n1 q1 `union` PairQ n2 q2 = PairQ (n1 + n2) (meldHeap (<=) q1 q2)
+
+  /O(n)/. Takes the union of a list of priority queues. Produces a betterbalanced
+ priority queue than /foldr union empty/,
+unions :: Ord e => [PQueue e] > PQueue e
+unions = makeUnion0 (<=)
+ where makeUnion0 _ [] = Empty
+ makeUnion0 (<=) (Empty:qs) = makeUnion0 (<=) qs
+ makeUnion0 (<=) (PairQ n t:qs) = makeUnion10 n t qs where
+ makeUnion10 n t qs = n `seq` t `seq` case qs of
+ Empty:qs' > makeUnion10 n t qs'
+ PairQ n' t':qs' > makeUnion11 (n + n') t t' qs'
+ [] > PairQ n t
+ makeUnion11 n t0 t1 qs = n `seq` t0 `seq` t1 `seq` case qs of
+ Empty:qs' > makeUnion11 n t0 t1 qs'
+ PairQ n2 t2:qs' > makeUnion10 (n + n2) (t0 `meld` (t1 `meld` t2)) qs'
+ [] > PairQ n (t0 `meld` t1)
+ meld = meldHeap (<=)
+
+  /O(1)/. View the top (minimum) element of the queue, if there is one.
+top :: Ord a => PQueue a > Maybe a
+top = fmap fst . extract
+
+  /O(log n)/. Extract the top (minimum) element of the sequence, if there is one.
+extract :: Ord a => PQueue a > Maybe (a, PQueue a)
+extract Empty = Nothing
+extract (PairQ n (PHeap x ts)) =
+ Just (x, case meldAll (<=) ts of
+ Nothing > Empty
+ Just q' > PairQ (n1) q')
+
+  /O(log n)/. Delete the top element of the sequence, if there is one.
+delete :: Ord a => PQueue a > Maybe (PQueue a)
+delete = fmap snd . extract
+
+tip :: e > PHeap e
+tip x = PHeap x Zero
+
+meldHeap :: (e > e > Bool) > PHeap e > PHeap e > PHeap e
+meldHeap (<=) = meld where
+ t1@(PHeap x1 ts1) `meld` t2@(PHeap x2 ts2)
+  x1 <= x2 = PHeap x1 (cons t2 ts1)
+  otherwise = PHeap x2 (cons t1 ts2)
+ cons t Zero = One t
+ cons t1 (One t0) = Two t0 t1
+ cons t2 (Two t0 t1) = One ((t1 `meld` t2) `meld` t0)
+
+{# INLINE meldAll #}
+meldAll :: (e > e > Bool) > PChildren e > Maybe (PHeap e)
+meldAll _ Zero = Nothing
+meldAll _ (One t) = Just t
+meldAll (<=) (Two t0 t1) = Just $ meldHeap (<=) t0 t1
+
+{# INLINE fromAscList #}
+  /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.
+fromAscList :: [a] > PQueue a
+fromAscList = foldr insMin empty
+
+insMin :: a > PQueue a > PQueue a
+insMin x Empty = singleton x
+insMin x (PairQ n t) = PairQ n (PHeap x (One t))
+
+  /O(n)/. Produces a priority queue from an unordered list. Produces a slightly more balanced pairing
+ heap then @'foldr' 'insert' 'empty'@.
+fromList :: Ord a => [a] > PQueue a
+fromList [] = Empty
+fromList (x:xs) = fromListHelper (<=) x xs
+
+{# NOINLINE fromListHelper #}
+fromListHelper :: (a > a > Bool) > a > [a] > PQueue a
+fromListHelper _ x [] = singleton x
+fromListHelper (<=) x1 (x2:xs) = fromList0 2 (tip x1 `meld` tip x2) xs where
+ fromList0 n t xs = n `seq` t `seq` case xs of
+ [] > PairQ n t
+ x:xs > fromList1 (n+1) t x xs
+ fromList1 n t0 x1 xs = n `seq` t0 `seq` case xs of
+ [] > PairQ (n+1) (tip x1 `meld` t0)
+ x2:xs > fromList0 (n+1) ((tip x1 `meld` tip x2) `meld` t0) xs
+ meld = meldHeap (<=)
+
+  /O(n log n)/. Performs a rightfold on the elements of a priority queue in ascending order.
+foldrAsc :: Ord a => (a > b > b) > b > PQueue a > b
+foldrAsc f z (PairQ _ t) = foldrAscH (<=) f z t
+foldrAsc _ z _ = z
+
+foldrAscH :: (a > a > Bool) > (a > b > b) > b > PHeap a > b
+foldrAscH (<=) f = flip foldrHelper where
+ foldrHelper (PHeap x ts) z = x `f` foldr foldrHelper z (meldAll (<=) ts)
+
+  /O(n log n)/. Performs a leftfold on the elements of a priority queue in ascending order.
+foldlAsc :: Ord a => (b > a > b) > b > PQueue a > b
+foldlAsc f z (PairQ _ t) = foldlAscH (<=) f z t
+foldlAsc _ z _ = z
+
+foldlAscH :: (a > a > Bool) > (b > a > b) > b > PHeap a > b
+foldlAscH (<=) f = foldlHelper where
+ foldlHelper z (PHeap x ts) = foldl foldlHelper (z `f` x) (meldAll (<=) ts)
+
+{# INLINE toAscList #}
+  /O(n log n)/. Extracts the elements of the priority queue in ascending order.
+toAscList :: Ord a => PQueue a > [a]
+toAscList q = build (\ c nil > foldrAsc c nil q)
+
+{# INLINE toList #}
+  /O(n)/. Returns the elements of the priority queue in no particular order.
+toList :: PQueue a > [a]
+toList q = build (\ c nil > foldr c nil q)
+
+ data Filter a = EmptyF  Filter {# UNPACK #} !Int {# UNPACK #} !(PHeap a) (PChildren a)
+
+filter :: Ord a => (a > Bool) > PQueue a > PQueue a
+filter _ Empty = Empty
+filter p (PairQ _ t) = filterT t where
+ filterT (PHeap x ts) = (if p x then insMin x else id) $ case ts of
+ Zero > Empty
+ One t > filterT t
+ Two t0 t1 > filterT t0 `union` filterT t1
+
+partition :: Ord a => (a > Bool) > PQueue a > (PQueue a, PQueue a)
+partition _ Empty = (Empty, Empty)
+partition p (PairQ _ t) = partitionT t where
+ partitionT (PHeap x ts) = case partitionCh ts of
+ (q0, q1)
+  p x > (insMin x q0, q1)
+  otherwise > (q0, insMin x q1)
+ partitionCh Zero = (Empty, Empty)
+ partitionCh (One t) = partitionT t
+ partitionCh (Two t0 t1) = case (partitionT t0, partitionT t1) of
+ ((q00, q01), (q10, q11)) >
+ (q00 `union` q10, q01 `union` q11)
+
+  Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest element in the queue.
+(!!) :: Ord a => PQueue a > Int > a
+q !! n = (List.!!) (toAscList q) n
+
+{# INLINE takeWhile #}
+  'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the
+ longest prefix (possibly empty) of @queue@ of elements that satisfy @p@.
+takeWhile :: Ord a => (a > Bool) > PQueue a > [a]
+takeWhile p = List.takeWhile p . toAscList
+
+  'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.
+dropWhile :: Ord a => (a > Bool) > PQueue a > PQueue a
+dropWhile p = dropWhileHelper where
+ dropWhileHelper q = case extract q of
+ Just (x, q')  p x > dropWhile p q'
+ _ > q
+
+  'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where
+ first element is longest prefix (possibly empty) of @queue@ of elements that
+ satisfy @p@ and second element is the remainder of the queue.
+span :: Ord a => (a > Bool) > PQueue a > ([a], PQueue a)
+span p queue = case extract queue of
+ Just (x, q')  p x > let (ys, q'') = span p q' in (x:ys, q'')
+ _ > ([], queue)
+
+  'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where
+ first element is longest prefix (possibly empty) of @queue@ of elements that
+ /do not satisfy/ @p@ and second element is the remainder of the queue.
+break :: Ord a => (a > Bool) > PQueue a > ([a], PQueue a)
+break p = span (not . p)
+
+{# INLINE take #}
+  /O(k log n)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
+ or all elements of @queue@ itself if @k >= 'size' queue@.
+take :: Ord a => Int > PQueue a > [a]
+take n = List.take n . toAscList
+
+  /O(k log n)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
+ or an empty queue if @k >= size 'queue'@.
+drop :: Ord a => Int > PQueue a > PQueue a
+drop n queue
+  n <= 0 = queue
+  otherwise = case delete queue of
+ Nothing > empty
+ Just queue' > drop (n1) queue'
+
+  /O(k log n)/. Equivalent to @('take' k queue, 'drop' k queue)@.
+splitAt :: Ord a => Int > PQueue a > ([a], PQueue a)
+splitAt n queue
+  n <= 0 = ([], queue)
+  otherwise = case extract queue of
+ Nothing > ([], queue)
+ Just (x, queue') > let (xs, queue'') = splitAt (n1) queue' in (x:xs, queue'')
+
+  /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
+ as in 'fmap'. If it is not, the result is undefined.
+mapMonotonic :: (a > b) > PQueue a > PQueue b
+mapMonotonic = fmap
+
+  /O(n)/. Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation.
+ If the function is not monotonic, the result is undefined.
+traverseMonotonic :: Applicative f => (a > f b) > PQueue a > f (PQueue b)
+traverseMonotonic = traverse
}
Context:
[Tweak layout to work with the alternative layout rule
Ian Lynagh **20091129154519]
[Disable building Data.Sequence (and dependents) for nhc98.
Malcolm.Wallace@cs.york.ac.uk**20091124025653
There is some subtlety of polymorphically recursive datatypes and
typeclass defaulting that nhc98's type system barfs over.
]
[Fix another instance of nonghc breakage.
Malcolm.Wallace@cs.york.ac.uk**20091123092637]
[Add #ifdef around ghconly (<$) as member of Functor class.
Malcolm.Wallace@cs.york.ac.uk**20091123085155]
[Fix broken code in nonGHC branch of an ifdef.
Malcolm.Wallace@cs.york.ac.uk**20091123084824]
[doc bugfix: correct description of index argument
Ross Paterson **20091028105532
Ignorethis: 9790e7bf422c4cb528722c03cfa4fed9
As noted by iaefai on the libraries list.
Please merge to STABLE.
]
[Bump version to 0.3.0.0
Ian Lynagh **20090920141847]
[update base dependency
Ross Paterson **20090916073125
Ignorethis: ad382ffc6c6a18c15364e6c072f19edb
The package uses mkNoRepType and Data.Functor, which were not in the
stable branch of base4.
]
[add fast version of <$ for Seq
Ross Paterson **20090916072812
Ignorethis: 5a39a7d31d39760ed589790b1118d240
]
[new methods for Data.Sequence (proposal #3271)
Ross Paterson **20090915173324
Ignorethis: cf17bedd709a6ab3448fd718dcdf62e7
Adds a lot of new methods to Data.Sequence, mostly paralleling those
in Data.List. Several of these are significantly faster than versions
implemented with the previous public interface. In particular, replicate
takes O(log n) time and space instead of O(n).
(by Louis Wasserman)
]
[Fix "Cabal check" warnings
Ian Lynagh **20090811215900]
[TAG 20090625
Ian Lynagh **20090625160202]
Patch bundle hash:
9d207dcfbee69b4f5f0f7ed78038ae96109a6940