pqueue-1.4.1.2/0000755000000000000000000000000013352773633011363 5ustar0000000000000000pqueue-1.4.1.2/PQueueTests.hs0000644000000000000000000001045113352773633014147 0ustar0000000000000000module Main (main) where import qualified Data.PQueue.Prio.Max as PMax () import qualified Data.PQueue.Prio.Min as PMin () import qualified Data.PQueue.Max as Max () import qualified Data.PQueue.Min as Min import Test.QuickCheck import System.Exit import qualified Data.List as List import Control.Arrow (second) validMinToAscList :: [Int] -> Bool validMinToAscList xs = Min.toAscList (Min.fromList xs) == List.sort xs validMinToDescList :: [Int] -> Bool validMinToDescList xs = Min.toDescList (Min.fromList xs) == List.sortBy (flip compare) xs validMinUnfoldr :: [Int] -> Bool validMinUnfoldr xs = List.unfoldr Min.minView (Min.fromList xs) == List.sort xs validMinToList :: [Int] -> Bool validMinToList xs = List.sort (Min.toList (Min.fromList xs)) == List.sort xs validMinFromAscList :: [Int] -> Bool validMinFromAscList xs = Min.fromAscList (List.sort xs) == Min.fromList xs validMinFromDescList :: [Int] -> Bool validMinFromDescList xs = Min.fromDescList (List.sortBy (flip compare) xs) == Min.fromList xs validMinUnion :: [Int] -> [Int] -> Bool validMinUnion xs1 xs2 = Min.union (Min.fromList xs1) (Min.fromList xs2) == Min.fromList (xs1 ++ xs2) validMinMapMonotonic :: [Int] -> Bool validMinMapMonotonic xs = Min.mapU (+1) (Min.fromList xs) == Min.fromList (map (+1) xs) validMinFilter :: [Int] -> Bool validMinFilter xs = Min.filter even (Min.fromList xs) == Min.fromList (List.filter even xs) validMinPartition :: [Int] -> Bool validMinPartition xs = Min.partition even (Min.fromList xs) == (let (xs1, xs2) = List.partition even xs in (Min.fromList xs1, Min.fromList xs2)) validMinCmp :: [Int] -> [Int] -> Bool validMinCmp xs1 xs2 = compare (Min.fromList xs1) (Min.fromList xs2) == compare (List.sort xs1) (List.sort xs2) validMinCmp2 :: [Int] -> Bool validMinCmp2 xs = compare (Min.fromList ys) (Min.fromList (take 30 ys)) == compare ys (take 30 ys) where ys = List.sort xs validSpan :: [Int] -> Bool validSpan xs = (Min.takeWhile even q, Min.dropWhile even q) == Min.span even q where q = Min.fromList xs validSpan2 :: [Int] -> Bool validSpan2 xs = second Min.toAscList (Min.span even (Min.fromList xs)) == List.span even (List.sort xs) validSplit :: Int -> [Int] -> Bool validSplit n xs = Min.splitAt n q == (Min.take n q, Min.drop n q) where q = Min.fromList xs validSplit2 :: Int -> [Int] -> Bool validSplit2 n xs = case Min.splitAt n (Min.fromList xs) of (ys, q') -> (ys, Min.toAscList q') == List.splitAt n (List.sort xs) validMapEither :: [Int] -> Bool validMapEither xs = Min.mapEither collatz q == (Min.mapMaybe (either Just (const Nothing) . collatz) q, Min.mapMaybe (either (const Nothing) Just . collatz) q) where q = Min.fromList xs validMap :: [Int] -> Bool validMap xs = Min.map f (Min.fromList xs) == Min.fromList (List.map f xs) where f = either id id . collatz collatz :: Int -> Either Int Int collatz x = if even x then Left $ x `quot` 2 else Right $ 3 * x + 1 validSize :: [Int] -> Bool validSize xs = Min.size q == List.length xs' where q = Min.drop 10 (Min.fromList xs) xs' = List.drop 10 (List.sort xs) validNull :: Int -> [Int] -> Bool validNull n xs = Min.null q == List.null xs' where q = Min.drop n (Min.fromList xs) xs' = List.drop n (List.sort xs) validFoldl :: [Int] -> Bool validFoldl xs = Min.foldlAsc (flip (:)) [] (Min.fromList xs) == List.foldl (flip (:)) [] (List.sort xs) validFoldlU :: [Int] -> Bool validFoldlU xs = Min.foldlU (flip (:)) [] q == List.reverse (Min.foldrU (:) [] q) where q = Min.fromList xs validFoldrU :: [Int] -> Bool validFoldrU xs = Min.foldrU (+) 0 q == List.sum xs where q = Min.fromList xs main :: IO () main = do check validMinToAscList check validMinToDescList check validMinUnfoldr check validMinToList check validMinFromAscList check validMinFromDescList check validMinUnion check validMinMapMonotonic check validMinPartition check validMinCmp check validMinCmp2 check validSpan check validSpan2 check validSplit check validSplit2 check validMinFilter check validMapEither check validMap check validSize check validNull check validFoldl check validFoldlU check validFoldrU isPass :: Result -> Bool isPass Success{} = True isPass _ = False check :: Testable prop => prop -> IO () check p = do r <- quickCheckResult p if isPass r then return () else exitFailure pqueue-1.4.1.2/Setup.lhs0000644000000000000000000000011613352773633013171 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain pqueue-1.4.1.2/LICENSE0000644000000000000000000000005313352773633012366 0ustar0000000000000000Copyright Louis Wasserman 2010 BSD license pqueue-1.4.1.2/pqueue.cabal0000644000000000000000000000407013352773633013654 0ustar0000000000000000Name: pqueue Version: 1.4.1.2 Category: Data Structures Author: Louis Wasserman License: BSD3 License-file: LICENSE Stability: experimental Synopsis: Reliable, persistent, fast priority queues. Description: A fast, reliable priority queue implementation based on a binomial heap. Maintainer: Lennart Spitzner Louis Wasserman Bug-reports: https://github.com/lspitzner/pqueue/issues Build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1 extra-source-files: { include/Typeable.h CHANGELOG.md } source-repository head type: git location: git@github.com:lspitzner/pqueue.git Library { default-language: Haskell2010 build-depends: { base >= 4.8 && < 4.13 , deepseq >= 1.3 && < 1.5 } exposed-modules: Data.PQueue.Prio.Min Data.PQueue.Prio.Max Data.PQueue.Min Data.PQueue.Max other-modules: Data.PQueue.Prio.Internals Data.PQueue.Internals Data.PQueue.Prio.Max.Internals Control.Applicative.Identity if impl(ghc) { default-extensions: DeriveDataTypeable } ghc-options: { -fdicts-strict -Wall -fno-warn-inline-rule-shadowing } if impl(ghc>=7.10) { ghc-options: { -fno-warn-unused-imports } } } Test-Suite test default-language: Haskell2010 Type: exitcode-stdio-1.0 Main-Is: PQueueTests.hs Build-Depends: { base >= 4.8 && < 4.13 , deepseq >= 1.3 && < 1.5 , QuickCheck >=2.5 && <3 } ghc-options: { -Wall -fno-warn-inline-rule-shadowing } if impl(ghc>=7.10) { ghc-options: { -fno-warn-unused-imports } } If impl(ghc) default-extensions: DeriveDataTypeable other-modules: Data.PQueue.Prio.Internals Data.PQueue.Internals Data.PQueue.Prio.Max.Internals Control.Applicative.Identity Data.PQueue.Prio.Min Data.PQueue.Prio.Max Data.PQueue.Min Data.PQueue.Max pqueue-1.4.1.2/CHANGELOG.md0000644000000000000000000000243413352773633013177 0ustar0000000000000000# Revision history for pqueue ## 1.4.1.2 -- 2018-09-26 * Maintenance release for ghc-8.6 * Drop support for ghc<7.10 ## 1.4.1.1 -- 2018-02-11 * Remove/Replace buggy insertBehind implementation. The existing implementation did not always insert behind. As a fix, the function was removed from Data.PQueue.Max/Min and was rewritten with a O(n) complexity (!) for Data.PQueue.Prio.Max/Min. * Adapt for ghc-8.4, based on the ghc-8.4.1-alpha1 release * Drop support for ghc<7.4 ## 1.3.2.3 -- 2017-08-01 * Maintenance release for ghc-8.2 ## 1.3.2.2 -- 2017-03-12 * Add test-suite from darcs repository for pqueue-1.0.1. ## 1.3.2.1 -- 2017-03-11 * Fix documentation errors - complexity on `toList`, `toListU` - PQueue.Prio.Max had "ascending" instead of "descending" in some places ## 1.3.2 -- 2016-09-28 * Add function `insertBehind` as a slight variation of `insert` which differs in behaviour for elements the compare equal. ## 1.3.1.1 -- 2016-05-21 * Ensure compatibility with ghc-8 * Minor internal refactors ## 1.3.1 -- 2015-10-03 * Add Monoid instance for MaxPQueue ## 1.3.0 -- 2015-06-23 * Lennart Spitzner starts co-maintaining * new git repository at github.com:lspitzner/pqueue * Ensure compatibility with ghc-7.10 pqueue-1.4.1.2/Data/0000755000000000000000000000000013352773633012234 5ustar0000000000000000pqueue-1.4.1.2/Data/PQueue/0000755000000000000000000000000013352773633013440 5ustar0000000000000000pqueue-1.4.1.2/Data/PQueue/Min.hs0000644000000000000000000002415213352773633014523 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.PQueue.Min -- Copyright : (c) Louis Wasserman 2010 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- General purpose priority queue, supporting extract-minimum operations. -- -- An amortized running time is given for each operation, with /n/ referring -- to the length of the sequence and /k/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. -- -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily. To force the spine of the heap, -- use 'seqSpine'. -- -- This implementation does not guarantee stable behavior. -- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Min ( MinQueue, -- * Basic operations empty, null, size, -- * Query operations findMin, getMin, deleteMin, deleteFindMin, minView, -- * Construction operations singleton, insert, union, unions, -- * Subsets -- ** Extracting subsets (!!), take, drop, splitAt, -- ** Predicates takeWhile, dropWhile, span, break, -- * Filter/Map filter, partition, mapMaybe, mapEither, -- * Fold\/Functor\/Traversable variations map, foldrAsc, foldlAsc, foldrDesc, foldlDesc, -- * List operations toList, toAscList, toDescList, fromList, fromAscList, fromDescList, -- * Unordered operations mapU, foldrU, foldlU, elemsU, toListU, -- * Miscellaneous operations keysQueue, seqSpine) where import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) import Data.Monoid (Monoid(mempty, mappend, mconcat)) import Data.Foldable (foldl, foldr, foldl') import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup((<>))) #endif import qualified Data.List as List import Data.PQueue.Internals #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] #endif -- instance instance (Ord a, Show a) => Show (MinQueue a) where showsPrec p xs = showParen (p > 10) $ showString "fromAscList " . shows (toAscList xs) instance Read a => Read (MinQueue a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromAscList" <- lexP xs <- readPrec return (fromAscList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromAscList",s) <- lex r (xs,t) <- reads s return (fromAscList xs,t) #endif #if MIN_VERSION_base(4,9,0) instance Ord a => Semigroup (MinQueue a) where (<>) = union #endif instance Ord a => Monoid (MinQueue a) where mempty = empty mappend = union mconcat = unions -- | /O(1)/. Returns the minimum element. Throws an error on an empty queue. findMin :: MinQueue a -> a findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin -- | /O(log n)/. Deletes the minimum element. If the queue is empty, does nothing. deleteMin :: Ord a => MinQueue a -> MinQueue a deleteMin q = case minView q of Nothing -> empty Just (_, q') -> q' -- | /O(log n)/. Extracts the minimum element. Throws an error on an empty queue. deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a) deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView -- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@. unions :: Ord a => [MinQueue a] -> MinQueue a unions = foldl union empty -- | /O(k log n)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest -- element in the queue. Equivalent to @toAscList queue !! k@. (!!) :: Ord a => MinQueue a -> Int -> a q !! n | n >= size q = error "Data.PQueue.Min.!!: index too large" q !! n = (List.!!) (toAscList q) n {-# INLINE takeWhile #-} -- | 'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the -- longest prefix (possibly empty) of @queue@ of elements that satisfy @p@. takeWhile :: Ord a => (a -> Bool) -> MinQueue a -> [a] takeWhile p = foldWhileFB p . toAscList {-# INLINE foldWhileFB #-} -- | Equivalent to Data.List.takeWhile, but is a better producer. foldWhileFB :: (a -> Bool) -> [a] -> [a] foldWhileFB p xs0 = build (\ c nil -> let consWhile x xs | p x = x `c` xs | otherwise = nil in foldr consWhile nil xs0) -- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a dropWhile p = drop' where drop' q = case minView q of Just (x, q') | p x -> drop' q' _ -> q -- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where -- first element is longest prefix (possibly empty) of @queue@ of elements that -- satisfy @p@ and second element is the remainder of the queue. span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a) span p queue = case minView queue of Just (x, q') | p x -> let (ys, q'') = span p q' in (x:ys, q'') _ -> ([], queue) -- | 'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where -- first element is longest prefix (possibly empty) of @queue@ of elements that -- /do not satisfy/ @p@ and second element is the remainder of the queue. break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a) break p = span (not . p) {-# INLINE take #-} -- | /O(k log n)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@, -- or all elements of @queue@ itself if @k >= 'size' queue@. take :: Ord a => Int -> MinQueue a -> [a] take n = List.take n . toAscList -- | /O(k log n)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted, -- or an empty queue if @k >= size 'queue'@. drop :: Ord a => Int -> MinQueue a -> MinQueue a drop n queue = n `seq` case minView queue of Just (_, queue') | n > 0 -> drop (n-1) queue' _ -> queue -- | /O(k log n)/. Equivalent to @('take' k queue, 'drop' k queue)@. splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a) splitAt n queue = n `seq` case minView queue of Just (x, queue') | n > 0 -> let (xs, queue'') = splitAt (n-1) queue' in (x:xs, queue'') _ -> ([], queue) -- | /O(n)/. Returns the queue with all elements not satisfying @p@ removed. filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a filter p = mapMaybe (\ x -> if p x then Just x else Nothing) -- | /O(n)/. Returns a pair where the first queue contains all elements satisfying @p@, and the second queue -- contains all elements not satisfying @p@. partition :: Ord a => (a -> Bool) -> MinQueue a -> (MinQueue a, MinQueue a) partition p = mapEither (\ x -> if p x then Left x else Right x) -- | /O(n)/. Creates a new priority queue containing the images of the elements of this queue. -- Equivalent to @'fromList' . 'Data.List.map' f . toList@. map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b map f = foldrU (insert . f) empty {-# INLINE toAscList #-} -- | /O(n log n)/. Extracts the elements of the priority queue in ascending order. toAscList :: Ord a => MinQueue a -> [a] toAscList queue = build (\ c nil -> foldrAsc c nil queue) {-# INLINE toDescList #-} -- | /O(n log n)/. Extracts the elements of the priority queue in descending order. toDescList :: Ord a => MinQueue a -> [a] toDescList queue = build (\ c nil -> foldrDesc c nil queue) {-# INLINE toList #-} -- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toAscList'. -- -- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MinQueue a -> [a] toList = toAscList {-# RULES "toAscList" forall q . toAscList q = build (\ c nil -> foldrAsc c nil q); -- inlining doesn't seem to be working out =/ "toDescList" forall q . toDescList q = build (\ c nil -> foldrDesc c nil q); #-} -- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in descending order. -- @foldrDesc f z q == foldlAsc (flip f) z q@. foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b foldrDesc = foldlAsc . flip -- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in descending order. -- @foldlDesc f z q == foldrAsc (flip f) z q@. foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b foldlDesc = foldrAsc . flip {-# INLINE fromList #-} -- | /O(n)/. Constructs a priority queue from an unordered list. fromList :: Ord a => [a] -> MinQueue a fromList = foldr insert empty {-# RULES "fromList" fromList = foldr insert empty; "fromAscList" fromAscList = foldr insertMinQ empty; #-} {-# INLINE fromAscList #-} -- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. fromAscList :: [a] -> MinQueue a fromAscList = foldr insertMinQ empty -- | /O(n)/. Constructs a priority queue from an descending list. /Warning/: Does not check the precondition. fromDescList :: [a] -> MinQueue a fromDescList = foldl' (flip insertMinQ) empty -- | Maps a function over the elements of the queue, ignoring order. This function is only safe if the function is monotonic. -- This function /does not/ check the precondition. mapU :: (a -> b) -> MinQueue a -> MinQueue b mapU = mapMonotonic {-# INLINE elemsU #-} -- | Equivalent to 'toListU'. elemsU :: MinQueue a -> [a] elemsU = toListU -- | /O(n)/. Returns the elements of the queue, in no particular order. toListU :: MinQueue a -> [a] toListU q = build (\ c n -> foldrU c n q) {-# RULES "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q; "foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q; #-} pqueue-1.4.1.2/Data/PQueue/Internals.hs0000644000000000000000000004465113352773633015745 0ustar0000000000000000{-# LANGUAGE CPP, StandaloneDeriving #-} module Data.PQueue.Internals ( MinQueue (..), BinomHeap, BinomForest(..), BinomTree(..), Succ(..), Zero(..), LEq, empty, null, size, getMin, minView, singleton, insert, union, mapMaybe, mapEither, mapMonotonic, foldrAsc, foldlAsc, insertMinQ, -- mapU, foldrU, foldlU, -- traverseU, keysQueue, seqSpine ) where import Control.DeepSeq (NFData(rnf), deepseq) import Data.Functor ((<$>)) import Data.Foldable (Foldable (foldr, foldl)) import Data.Monoid (mappend) import qualified Data.PQueue.Prio.Internals as Prio #ifdef __GLASGOW_HASKELL__ import Data.Data #endif import Prelude hiding (foldl, foldr, null) -- | A priority queue with elements of type @a@. Supports extracting the minimum element. data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a) #if __GLASGOW_HASKELL__>=707 deriving Typeable #else #include "Typeable.h" INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue") #endif #ifdef __GLASGOW_HASKELL__ instance (Ord a, Data a) => Data (MinQueue a) where gfoldl f z q = case minView q of Nothing -> z Empty Just (x, q') -> z insertMinQ `f` x `f` q' gunfold k z c = case constrIndex c of 1 -> z Empty 2 -> k (k (z insertMinQ)) _ -> error "gunfold" dataCast1 x = gcast1 x toConstr q | null q = emptyConstr | otherwise = consConstr dataTypeOf _ = queueDataType queueDataType :: DataType queueDataType = mkDataType "Data.PQueue.Min.MinQueue" [emptyConstr, consConstr] emptyConstr, consConstr :: Constr emptyConstr = mkConstr queueDataType "empty" [] Prefix consConstr = mkConstr queueDataType "<|" [] Infix #endif type BinomHeap = BinomForest Zero instance Ord a => Eq (MinQueue a) where Empty == Empty = True MinQueue n1 x1 q1 == MinQueue n2 x2 q2 = n1 == n2 && eqExtract (x1,q1) (x2,q2) _ == _ = False eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool eqExtract (x1,q1) (x2,q2) = x1 == x2 && case (extractHeap q1, extractHeap q2) of (Just h1, Just h2) -> eqExtract h1 h2 (Nothing, Nothing) -> True _ -> 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 = cmpExtract (x1,q1) (x2,q2) cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering cmpExtract (x1,q1) (x2,q2) = compare x1 x2 `mappend` case (extractHeap q1, extractHeap q2) of (Just h1, Just h2) -> cmpExtract h1 h2 (Nothing, Nothing) -> EQ (Just _, Nothing) -> GT (Nothing, Just _) -> LT -- We compare their first elements, then their other elements up to the smaller queue's length, -- and then the longer queue wins. -- This is equivalent to @comparing toAscList@, except it fuses much more nicely. -- We implement tree ranks in the type system with a nicely elegant approach, as follows. -- The goal is to have the type system automatically guarantee that our binomial forest -- has the correct binomial structure. -- -- In the traditional set-theoretic construction of the natural numbers, we define -- each number to be the set of numbers less than it, and Zero to be the empty set, -- as follows: -- -- 0 = {} 1 = {0} 2 = {0, 1} 3={0, 1, 2} ... -- -- Binomial trees have a similar structure: a tree of rank @k@ has one child of each -- rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer -- to a collection of binomial trees of ranks @0..k-1@. Then we can say that -- -- > data Succ rk a = Succ (BinomTree rk a) (rk a) -- -- and this behaves exactly as the successor operator for ranks should behave. Furthermore, -- we immediately obtain that -- -- > data BinomTree rk a = BinomTree a (rk a) -- -- which is nice and compact. With this construction, things work out extremely nicely: -- -- > BinomTree (Succ (Succ (Succ Zero))) -- -- is a type constructor that takes an element type and returns the type of binomial trees -- of rank @3@. data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) | Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a) data BinomTree rk a = BinomTree a (rk a) -- | If |rk| corresponds to rank @k@, then |'Succ' rk| corresponds to rank @k+1@. data Succ rk a = Succ {-# UNPACK #-} !(BinomTree rk a) (rk a) -- | Type corresponding to the Zero rank. data Zero a = Zero -- | Type alias for a comparison function. type LEq a = a -> a -> Bool -- basics -- | /O(1)/. The empty priority queue. empty :: MinQueue a empty = Empty -- | /O(1)/. Is this the empty priority queue? null :: MinQueue a -> Bool null Empty = True null _ = False -- | /O(1)/. The number of elements in the queue. size :: MinQueue a -> Int size Empty = 0 size (MinQueue n _ _) = n -- | Returns the minimum element of the queue, if the queue is nonempty. getMin :: MinQueue a -> Maybe a getMin (MinQueue _ x _) = Just x getMin _ = Nothing -- | Retrieves the minimum element of the queue, and the queue stripped of that element, -- or 'Nothing' if passed an empty queue. minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a) minView Empty = Nothing minView (MinQueue n x ts) = Just (x, case extractHeap ts of Nothing -> Empty Just (x', ts') -> MinQueue (n-1) x' ts') -- | /O(1)/. Construct a priority queue with a single element. singleton :: a -> MinQueue a singleton x = MinQueue 1 x Nil -- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element into the priority queue. insert :: Ord a => a -> MinQueue a -> MinQueue a insert = insert' (<=) -- | Amortized /O(log (min(n,m)))/, worst-case /O(log (max (n,m)))/. Take the union of two priority queues. union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a union = union' (<=) -- | /O(n)/. Map elements and collect the 'Just' results. mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b mapMaybe _ Empty = Empty mapMaybe f (MinQueue _ x ts) = maybe q' (`insert` q') (f x) where q' = mapMaybeQueue f (<=) (const Empty) Empty ts -- | /O(n)/. Map elements and separate the 'Left' and 'Right' results. mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c) mapEither _ Empty = (Empty, Empty) mapEither f (MinQueue _ x ts) = case (mapEitherQueue f (<=) (<=) (const (Empty, Empty)) (Empty, Empty) ts, f x) of ((qL, qR), Left b) -> (insert b qL, qR) ((qL, qR), Right c) -> (qL, insert c qR) -- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue, -- as in 'fmap'. If it is not, the result is undefined. mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b mapMonotonic = mapU {-# INLINE foldrAsc #-} -- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order. foldrAsc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b foldrAsc _ z Empty = z foldrAsc f z (MinQueue _ x ts) = x `f` foldrUnfold f z extractHeap ts {-# INLINE foldrUnfold #-} -- | Equivalent to @foldr f z (unfoldr suc s0)@. foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c foldrUnfold f z suc s0 = unf s0 where unf s = case suc s of Nothing -> z Just (x, s') -> x `f` unf s' -- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in ascending order. foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b foldlAsc _ z Empty = z foldlAsc f z (MinQueue _ x ts) = foldlUnfold f (z `f` x) extractHeap ts {-# INLINE foldlUnfold #-} -- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@. foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c foldlUnfold f z0 suc s0 = unf z0 s0 where unf z s = case suc s of Nothing -> z Just (x, s') -> unf (z `f` x) s' insert' :: LEq a -> a -> MinQueue a -> MinQueue a insert' _ x Empty = singleton x insert' le x (MinQueue n x' ts) | x `le` x' = MinQueue (n+1) x (incr le (tip x') ts) | otherwise = MinQueue (n+1) x' (incr le (tip x) ts) {-# INLINE union' #-} union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a union' _ Empty q = q union' _ q Empty = q union' le (MinQueue n1 x1 f1) (MinQueue n2 x2 f2) | x1 `le` x2 = MinQueue (n1 + n2) x1 (carry le (tip x2) f1 f2) | otherwise = MinQueue (n1 + n2) x2 (carry le (tip x1) f1 f2) -- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root. extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a) extractHeap ts = case extractBin (<=) ts of Yes (Extract x _ ts') -> Just (x, ts') _ -> Nothing -- | A specialized type intended to organize the return of extract-min queries -- from a binomial forest. We walk all the way through the forest, and then -- walk backwards. @Extract rk a@ is the result type of an extract-min -- operation that has walked as far backwards of rank @rk@ -- that is, it -- has visited every root of rank @>= rk@. -- -- The interpretation of @Extract minKey children forest@ is -- -- * @minKey@ is the key of the minimum root visited so far. It may have -- any rank @>= rk@. We will denote the root corresponding to -- @minKey@ as @minRoot@. -- -- * @children@ is those children of @minRoot@ which have not yet been -- merged with the rest of the forest. Specifically, these are -- the children with rank @< rk@. -- -- * @forest@ is an accumulating parameter that maintains the partial -- reconstruction of the binomial forest without @minRoot@. It is -- the union of all old roots with rank @>= rk@ (except @minRoot@), -- with the set of all children of @minRoot@ with rank @>= rk@. -- Note that @forest@ is lazy, so if we discover a smaller key -- than @minKey@ later, we haven't wasted significant work. data Extract rk a = Extract a (rk a) (BinomForest rk a) data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a) incrExtract :: Extract (Succ rk) a -> Extract rk a incrExtract (Extract minKey (Succ kChild kChildren) ts) = Extract minKey kChildren (Cons kChild ts) incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a incrExtract' le t (Extract minKey (Succ kChild kChildren) ts) = Extract minKey kChildren (Skip (incr le (t `cat` kChild) ts)) where cat = joinBin le -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress. Each successive application of @extractBin@ takes -- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. extractBin :: LEq a -> BinomForest rk a -> MExtract rk a extractBin _ Nil = No extractBin le (Skip f) = case extractBin le f of Yes ex -> Yes (incrExtract ex) No -> No extractBin le (Cons t@(BinomTree x ts) f) = Yes $ case extractBin le f of Yes ex@(Extract minKey _ _) | minKey `lt` x -> incrExtract' le t ex _ -> Extract x ts (Skip f) where a `lt` b = not (b `le` a) mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b mapMaybeQueue f le fCh q0 forest = q0 `seq` case forest of Nil -> q0 Skip forest' -> mapMaybeQueue f le fCh' q0 forest' Cons t forest' -> mapMaybeQueue f le fCh' (union' le (mapMaybeT t) q0) forest' where fCh' (Succ t tss) = union' le (mapMaybeT t) (fCh tss) mapMaybeT (BinomTree x0 ts) = maybe (fCh ts) (\ x -> insert' le x (fCh ts)) (f x0) type Partition a b = (MinQueue a, MinQueue b) mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c -> BinomForest rk a -> Partition b c mapEitherQueue f0 leB leC fCh (q00, q10) ts0 = q00 `seq` q10 `seq` case ts0 of Nil -> (q00, q10) Skip ts' -> mapEitherQueue f0 leB leC fCh' (q00, q10) ts' Cons t ts' -> mapEitherQueue f0 leB leC fCh' (both (union' leB) (union' leC) (partitionT t) (q00, q10)) ts' where both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2) fCh' (Succ t tss) = both (union' leB) (union' leC) (partitionT t) (fCh tss) partitionT (BinomTree x ts) = case fCh ts of (q0, q1) -> case f0 x of Left b -> (insert' leB b q0, q1) Right c -> (q0, insert' leC c q1) {-# INLINE tip #-} -- | Constructs a binomial tree of rank 0. tip :: a -> BinomTree Zero a tip x = BinomTree x Zero insertMinQ :: a -> MinQueue a -> MinQueue a insertMinQ x Empty = singleton x insertMinQ x (MinQueue n x' f) = MinQueue (n+1) x (insertMin (tip x') f) -- | @insertMin t f@ assumes that the root of @t@ compares as less than -- every other root in @f@, and merges accordingly. insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a insertMin t Nil = Cons t Nil insertMin t (Skip f) = Cons t f insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f) -- | Given two binomial forests starting at rank @rk@, takes their union. -- Each successive application of this function costs /O(1)/, so applying it -- from the beginning costs /O(log n)/. merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a merge le f1 f2 = case (f1, f2) of (Skip f1', Skip f2') -> Skip (merge le f1' f2') (Skip f1', Cons t2 f2') -> Cons t2 (merge le f1' f2') (Cons t1 f1', Skip f2') -> Cons t1 (merge le f1' f2') (Cons t1 f1', Cons t2 f2') -> Skip (carry le (t1 `cat` t2) f1' f2') (Nil, _) -> f2 (_, Nil) -> f1 where cat = joinBin le -- | Merges two binomial forests with another tree. If we are thinking of the trees -- in the binomial forest as binary digits, this corresponds to a carry operation. -- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/. carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a carry le t0 f1 f2 = t0 `seq` case (f1, f2) of (Skip f1', Skip f2') -> Cons t0 (merge le f1' f2') (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2') (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2') (Cons t1 f1', Cons t2 f2') -> Cons t0 (mergeCarry t1 t2 f1' f2') (Nil, _f2) -> incr le t0 f2 (_f1, Nil) -> incr le t0 f1 where cat = joinBin le mergeCarry tA tB = carry le (tA `cat` tB) -- | Merges a binomial tree into a binomial forest. If we are thinking -- of the trees in the binomial forest as binary digits, this corresponds -- to adding a power of 2. This costs amortized /O(1)/ time. incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a incr le t f0 = t `seq` case f0 of Nil -> Cons t Nil Skip f -> Cons t f Cons t' f' -> Skip (incr le (t `cat` t') f') where cat = joinBin le -- | The carrying operation: takes two binomial heaps of the same rank @k@ -- and returns one of rank @k+1@. Takes /O(1)/ time. joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a joinBin le t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2) | x1 `le` x2 = BinomTree x1 (Succ t2 ts1) | otherwise = BinomTree x2 (Succ t1 ts2) instance Functor Zero where fmap _ _ = Zero instance Functor rk => Functor (Succ rk) where fmap f (Succ t ts) = Succ (fmap f t) (fmap f ts) instance Functor rk => Functor (BinomTree rk) where fmap f (BinomTree x ts) = BinomTree (f x) (fmap f ts) instance Functor rk => Functor (BinomForest rk) where fmap _ Nil = Nil fmap f (Skip ts) = Skip (fmap f ts) fmap f (Cons t ts) = Cons (fmap f t) (fmap f ts) instance Foldable Zero where foldr _ z _ = z foldl _ z _ = z instance Foldable rk => Foldable (Succ rk) where foldr f z (Succ t ts) = foldr f (foldr f z ts) t foldl f z (Succ t ts) = foldl f (foldl f z t) ts instance Foldable rk => Foldable (BinomTree rk) where foldr f z (BinomTree x ts) = x `f` foldr f z ts foldl f z (BinomTree x ts) = foldl f (z `f` x) ts instance Foldable rk => Foldable (BinomForest rk) where foldr _ z Nil = z foldr f z (Skip tss) = foldr f z tss foldr f z (Cons t tss) = foldr f (foldr f z tss) t foldl _ z Nil = z foldl f z (Skip tss) = foldl f z tss foldl f z (Cons t tss) = foldl f (foldl f z t) tss -- instance Traversable Zero where -- traverse _ _ = pure Zero -- -- instance Traversable rk => Traversable (Succ rk) where -- traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts -- -- instance Traversable rk => Traversable (BinomTree rk) where -- traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts -- -- instance Traversable rk => Traversable (BinomForest rk) where -- traverse _ Nil = pure Nil -- traverse f (Skip tss) = Skip <$> traverse f tss -- traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss mapU :: (a -> b) -> MinQueue a -> MinQueue b mapU _ Empty = Empty mapU f (MinQueue n x ts) = MinQueue n (f x) (f <$> ts) -- | /O(n)/. Unordered right fold on a priority queue. foldrU :: (a -> b -> b) -> b -> MinQueue a -> b foldrU _ z Empty = z foldrU f z (MinQueue _ x ts) = x `f` foldr f z ts -- | /O(n)/. Unordered left fold on a priority queue. foldlU :: (b -> a -> b) -> b -> MinQueue a -> b foldlU _ z Empty = z foldlU f z (MinQueue _ x ts) = foldl f (z `f` x) ts -- traverseU :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b) -- traverseU _ Empty = pure Empty -- traverseU f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts -- | Forces the spine of the priority queue. seqSpine :: MinQueue a -> b -> b seqSpine Empty z = z seqSpine (MinQueue _ _ ts) z = seqSpineF ts z seqSpineF :: BinomForest rk a -> b -> b seqSpineF Nil z = z seqSpineF (Skip ts') z = seqSpineF ts' z seqSpineF (Cons _ ts') z = seqSpineF ts' z -- | Constructs a priority queue out of the keys of the specified 'Prio.MinPQueue'. keysQueue :: Prio.MinPQueue k a -> MinQueue k keysQueue Prio.Empty = Empty keysQueue (Prio.MinPQ n k _ ts) = MinQueue n k (keysF (const Zero) ts) keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k keysF f ts0 = case ts0 of Prio.Nil -> Nil Prio.Skip ts' -> Skip (keysF f' ts') Prio.Cons (Prio.BinomTree k _ ts) ts' -> Cons (BinomTree k (f ts)) (keysF f' ts') where f' (Prio.Succ (Prio.BinomTree k _ ts) tss) = Succ (BinomTree k (f ts)) (f tss) class NFRank rk where rnfRk :: NFData a => rk a -> () instance NFRank Zero where rnfRk _ = () instance NFRank rk => NFRank (Succ rk) where rnfRk (Succ t ts) = t `deepseq` rnfRk ts instance (NFData a, NFRank rk) => NFData (BinomTree rk a) where rnf (BinomTree x ts) = x `deepseq` rnfRk ts instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where rnf Nil = () rnf (Skip ts) = rnf ts rnf (Cons t ts) = t `deepseq` rnf ts instance NFData a => NFData (MinQueue a) where rnf Empty = () rnf (MinQueue _ x ts) = x `deepseq` rnf ts pqueue-1.4.1.2/Data/PQueue/Max.hs0000644000000000000000000003041713352773633014526 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Data.PQueue.Max -- Copyright : (c) Louis Wasserman 2010 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- General purpose priority queue, supporting view-maximum operations. -- -- An amortized running time is given for each operation, with /n/ referring -- to the length of the sequence and /k/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. -- -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily. To force the spine of the heap, -- use 'seqSpine'. -- -- This implementation does not guarantee stable behavior. -- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Max ( MaxQueue, -- * Basic operations empty, null, size, -- * Query operations findMax, getMax, deleteMax, deleteFindMax, delete, maxView, -- * Construction operations singleton, insert, union, unions, -- * Subsets -- ** Extracting subsets (!!), take, drop, splitAt, -- ** Predicates takeWhile, dropWhile, span, break, -- * Filter/Map filter, partition, mapMaybe, mapEither, -- * Fold\/Functor\/Traversable variations map, foldrAsc, foldlAsc, foldrDesc, foldlDesc, -- * List operations toList, toAscList, toDescList, fromList, fromAscList, fromDescList, -- * Unordered operations mapU, foldrU, foldlU, elemsU, toListU, -- * Miscellaneous operations keysQueue, seqSpine) where import Control.DeepSeq (NFData(rnf)) import Data.Functor ((<$>)) import Data.Monoid (Monoid(mempty, mappend)) import Data.Maybe (fromMaybe) import Data.Foldable (foldl, foldr) #if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup((<>))) #endif import qualified Data.PQueue.Min as Min import qualified Data.PQueue.Prio.Max.Internals as Prio import Data.PQueue.Prio.Max.Internals (Down(..)) 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) import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] #endif -- | A priority queue with elements of type @a@. Supports extracting the maximum element. -- Implemented as a wrapper around 'Min.MinQueue'. newtype MaxQueue a = MaxQ (Min.MinQueue (Down a)) # if __GLASGOW_HASKELL__ deriving (Eq, Ord, Data, Typeable) # else deriving (Eq, Ord) # endif instance NFData a => NFData (MaxQueue a) where rnf (MaxQ q) = rnf q 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 #if MIN_VERSION_base(4,9,0) instance Ord a => Semigroup (MaxQueue a) where (<>) = union #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(1)/. Returns the maximum element of the queue. Throws an error on an empty queue. findMax :: MaxQueue a -> a findMax = fromMaybe (error "Error: findMax called on empty queue") . getMax -- | /O(1)/. The top (maximum) element of the queue, if there is one. getMax :: MaxQueue a -> Maybe a getMax (MaxQ q) = unDown <$> Min.getMin q -- | /O(log n)/. Deletes the maximum element of the queue. Does nothing on an empty queue. deleteMax :: Ord a => MaxQueue a -> MaxQueue a deleteMax (MaxQ q) = MaxQ (Min.deleteMin q) -- | /O(log n)/. Extracts the maximum element of the queue. Throws an error on an empty queue. deleteFindMax :: Ord a => MaxQueue a -> (a, MaxQueue a) deleteFindMax = fromMaybe (error "Error: deleteFindMax called on empty queue") . maxView -- | /O(log n)/. Extract the top (maximum) element of the sequence, if there is one. maxView :: Ord a => MaxQueue a -> Maybe (a, MaxQueue a) maxView (MaxQ q) = case Min.minView 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 . maxView -- | /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 x `insert` MaxQ q = MaxQ (Down x `Min.insert` q) -- | /O(log (min(n1,n2)))/. Take the union of two priority queues. union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a MaxQ q1 `union` MaxQ q2 = MaxQ (q1 `Min.union` q2) -- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@. unions :: Ord a => [MaxQueue a] -> MaxQueue a unions qs = MaxQ (Min.unions [q | MaxQ q <- qs]) -- | /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) -- | /O(n)/. Returns a queue of those elements which satisfy the predicate. filter :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a filter p (MaxQ q) = MaxQ (Min.filter (p . unDown) q) -- | /O(n)/. Returns a pair of queues, where the left queue contains those elements that satisfy the predicate, -- and the right queue contains those that do not. 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)/. Maps a function over the elements of the queue, and collects the 'Just' values. mapMaybe :: Ord b => (a -> Maybe b) -> MaxQueue a -> MaxQueue b mapMaybe f (MaxQ q) = MaxQ (Min.mapMaybe (\ (Down x) -> Down <$> f x) q) -- | /O(n)/. Maps a function over the elements of the queue, and separates the 'Left' and 'Right' values. mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MaxQueue a -> (MaxQueue b, MaxQueue c) mapEither f (MaxQ q) = (MaxQ q0, MaxQ q1) where (q0, q1) = Min.mapEither (either (Left . Down) (Right . Down) . f . unDown) q -- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue. -- /Does not check the precondition/. mapU :: (a -> b) -> MaxQueue a -> MaxQueue b mapU f (MaxQ q) = MaxQ (Min.mapU (\ (Down a) -> Down (f a)) q) -- | /O(n)/. Unordered right fold on a priority queue. foldrU :: (a -> b -> b) -> b -> MaxQueue a -> b foldrU f z (MaxQ q) = Min.foldrU (flip (foldr f)) z q -- | /O(n)/. Unordered left fold on a priority queue. foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b foldlU f z (MaxQ q) = Min.foldlU (foldl f) z q {-# INLINE elemsU #-} -- | Equivalent to 'toListU'. elemsU :: MaxQueue a -> [a] elemsU = toListU {-# INLINE toListU #-} -- | /O(n)/. Returns a list of the elements of the priority queue, in no particular order. toListU :: MaxQueue a -> [a] toListU (MaxQ q) = map unDown (Min.toListU q) -- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order. -- @'foldrAsc' f z q == 'foldlDesc' (flip f) z q@. foldrAsc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b foldrAsc = foldlDesc . flip -- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in descending order. -- @'foldlAsc' f z q == 'foldrDesc' (flip f) z q@. foldlAsc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b foldlAsc = foldrDesc . flip -- | /O(n log n)/. Performs a right-fold 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 left-fold 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 toAscList #-} -- | /O(n log n)/. Extracts the elements of the priority queue in ascending order. toAscList :: Ord a => MaxQueue a -> [a] toAscList q = build (\ c nil -> foldrAsc c nil q) -- I can see no particular reason this does not simply forward to Min.toDescList. (lsp, 2016) {-# INLINE toDescList #-} -- | /O(n log n)/. Extracts the elements of the priority queue in descending order. toDescList :: Ord a => MaxQueue a -> [a] toDescList q = build (\ c nil -> foldrDesc c nil q) -- I can see no particular reason this does not simply forward to Min.toAscList. (lsp, 2016) {-# INLINE toList #-} -- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toDescList'. -- -- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MaxQueue a -> [a] toList (MaxQ q) = map unDown (Min.toList q) {-# INLINE fromAscList #-} -- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. fromAscList :: [a] -> MaxQueue a fromAscList = MaxQ . Min.fromDescList . map Down {-# INLINE fromDescList #-} -- | /O(n)/. Constructs a priority queue from a 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 -- | /O(n)/. Constructs a priority queue from the keys of a 'Prio.MaxPQueue'. keysQueue :: Prio.MaxPQueue k a -> MaxQueue k keysQueue (Prio.MaxPQ q) = MaxQ (Min.keysQueue q) -- | /O(log n)/. Forces the spine of the heap. seqSpine :: MaxQueue a -> b -> b seqSpine (MaxQ q) = Min.seqSpine q pqueue-1.4.1.2/Data/PQueue/Prio/0000755000000000000000000000000013352773633014351 5ustar0000000000000000pqueue-1.4.1.2/Data/PQueue/Prio/Min.hs0000644000000000000000000003462413352773633015441 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.PQueue.Prio.Min -- Copyright : (c) Louis Wasserman 2010 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- General purpose priority queue. -- Each element is associated with a /key/, and the priority queue supports -- viewing and extracting the element with the minimum key. -- -- A worst-case bound is given for each operation. In some cases, an amortized -- bound is also specified; these bounds do not hold in a persistent context. -- -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily. To force the spine of the heap, -- use 'seqSpine'. -- -- We do not guarantee stable behavior. -- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there -- are no guarantees about the relative order in which @k1@, @k2@, and their associated -- elements are returned. (Unlike Data.Map, we allow multiple elements with the -- same key.) -- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Prio.Min ( MinPQueue, -- * Construction empty, singleton, insert, insertBehind, union, unions, -- * Query null, size, -- ** Minimum view findMin, getMin, deleteMin, deleteFindMin, adjustMin, adjustMinWithKey, updateMin, updateMinWithKey, minView, minViewWithKey, -- * Traversal -- ** Map map, mapWithKey, mapKeys, mapKeysMonotonic, -- ** Fold foldrWithKey, foldlWithKey, -- ** Traverse traverseWithKey, -- * Subsets -- ** Indexed take, drop, splitAt, -- ** Predicates takeWhile, takeWhileWithKey, dropWhile, dropWhileWithKey, span, spanWithKey, break, breakWithKey, -- *** Filter filter, filterWithKey, partition, partitionWithKey, mapMaybe, mapMaybeWithKey, mapEither, mapEitherWithKey, -- * List operations -- ** Conversion from lists fromList, fromAscList, fromDescList, -- ** Conversion to lists keys, elems, assocs, toAscList, toDescList, toList, -- * Unordered operations foldrU, foldrWithKeyU, foldlU, foldlWithKeyU, traverseU, traverseWithKeyU, keysU, elemsU, assocsU, toListU, -- * Helper methods seqSpine ) where import Control.Applicative (Applicative, pure, (<*>), (<$>)) import qualified Data.List as List import qualified Data.Foldable as Fold(Foldable(..)) import Data.Monoid (Monoid(mempty, mappend, mconcat)) import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable) import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup((<>))) #endif import Data.PQueue.Prio.Internals import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null) #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 (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (f .: g) x y = f (g x y) uncurry' :: (a -> b -> c) -> (a, b) -> c uncurry' f (a, b) = f a b infixr 8 .: #if MIN_VERSION_base(4,9,0) instance Ord k => Semigroup (MinPQueue k a) where (<>) = union #endif instance Ord k => Monoid (MinPQueue k a) where mempty = empty mappend = union mconcat = unions instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where showsPrec p xs = showParen (p > 10) $ showString "fromAscList " . shows (toAscList xs) instance (Read k, Read a) => Read (MinPQueue k a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromAscList" <- lexP xs <- readPrec return (fromAscList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromAscList",s) <- lex r (xs,t) <- reads s return (fromAscList xs,t) #endif -- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@). unions :: Ord k => [MinPQueue k a] -> MinPQueue k a unions = List.foldl union empty -- | /O(1)/. The minimal (key, element) in the queue. Calls 'error' if empty. findMin :: MinPQueue k a -> (k, a) findMin = fromMaybe (error "Error: findMin called on an empty queue") . getMin -- | /O(log n)/. Deletes the minimal (key, element) in the queue. Returns an empty queue -- if the queue is empty. deleteMin :: Ord k => MinPQueue k a -> MinPQueue k a deleteMin = updateMin (const Nothing) -- | /O(log n)/. Delete and find the element with the minimum key. Calls 'error' if empty. deleteFindMin :: Ord k => MinPQueue k a -> ((k, a), MinPQueue k a) deleteFindMin = fromMaybe (error "Error: deleteFindMin called on an empty queue") . minViewWithKey -- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing. adjustMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a adjustMin = adjustMinWithKey . const -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key. -- If the queue is empty, does nothing. updateMin :: Ord k => (a -> Maybe a) -> MinPQueue k a -> MinPQueue k a updateMin = updateMinWithKey . const -- | /O(log n)/. Retrieves the value associated with the minimal key of the queue, and the queue -- stripped of that element, or 'Nothing' if passed an empty queue. minView :: Ord k => MinPQueue k a -> Maybe (a, MinPQueue k a) minView q = do ((_, a), q') <- minViewWithKey q return (a, q') -- | /O(n)/. Map a function over all values in the queue. map :: (a -> b) -> MinPQueue k a -> MinPQueue k b map = mapWithKey . const -- | /O(n)/. @'mapKeys' f q@ is the queue obtained by applying @f@ to each key of @q@. mapKeys :: Ord k' => (k -> k') -> MinPQueue k a -> MinPQueue k' a mapKeys f q = fromList [(f k, a) | (k, a) <- toListU q] -- | /O(n log n)/. Traverses the elements of the queue in ascending order by key. -- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@) -- -- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'. traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseWithKey f q = case minViewWithKey q of Nothing -> pure empty Just ((k, a), q') -> insertMin k <$> f k a <*> traverseWithKey f q' -- | /O(n)/. Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> MinPQueue k a -> MinPQueue k b mapMaybe = mapMaybeWithKey . const -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEither :: Ord k => (a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c) mapEither = mapEitherWithKey . const -- | /O(n)/. Filter all values that satisfy the predicate. filter :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a filter = filterWithKey . const -- | /O(n)/. Filter all values that satisfy the predicate. filterWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a filterWithKey p = mapMaybeWithKey (\ k a -> if p k a then Just a else Nothing) -- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements -- which satisfy the predicate, the second all elements that fail the predicate. partition :: Ord k => (a -> Bool) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a) partition = partitionWithKey . const -- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements -- which satisfy the predicate, the second all elements that fail the predicate. partitionWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a) partitionWithKey p = mapEitherWithKey (\ k a -> if p k a then Left a else Right a) {-# INLINE take #-} -- | /O(k log n)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@. -- (@'take' k q == 'List.take' k ('toAscList' q)@) take :: Ord k => Int -> MinPQueue k a -> [(k, a)] take n = List.take n . toAscList -- | /O(k log n)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@. drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a drop n0 q0 | n0 <= 0 = q0 | n0 >= size q0 = empty | otherwise = drop' n0 q0 where drop' n q | n == 0 = q | otherwise = drop' (n-1) (deleteMin q) -- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@. splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a) splitAt n q | n <= 0 = ([], q) | otherwise = n `seq` case minViewWithKey q of Just (ka, q') -> let (kas, q'') = splitAt (n-1) q' in (ka:kas, q'') _ -> ([], q) {-# INLINE takeWhile #-} -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toAscList' q)@) takeWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> [(k, a)] takeWhile = takeWhileWithKey . const {-# INLINE takeWhileWithKey #-} -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@) takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> [(k, a)] takeWhileWithKey p0 = takeWhileFB (uncurry' p0) . toAscList where takeWhileFB p xs = build (\ c n -> foldr (\ x z -> if p x then x `c` z else n) n xs) -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a dropWhile = dropWhileWithKey . const -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a dropWhileWithKey p q = case minViewWithKey q of Just ((k, a), q') | p k a -> dropWhileWithKey p q' _ -> q -- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@. span :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a) -- | Equivalent to @'span' ('not' . p)@. break :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a) span = spanWithKey . const break p = span (not . p) -- | Equivalent to @('takeWhileWithKey' p q, 'dropWhileWithKey' p q)@. spanWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a) -- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@. breakWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a) spanWithKey p q = case minViewWithKey q of Just (t@(k, a), q') | p k a -> let (kas, q'') = spanWithKey p q' in (t:kas, q'') _ -> ([], q) breakWithKey p = spanWithKey (not .: p) -- | /O(n)/. Build a priority queue from the list of (key, value) pairs. fromList :: Ord k => [(k, a)] -> MinPQueue k a fromList = foldr (uncurry' insert) empty -- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./ fromAscList :: [(k, a)] -> MinPQueue k a fromAscList = foldr (uncurry' insertMin) empty -- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./ fromDescList :: [(k, a)] -> MinPQueue k a fromDescList = List.foldl' (\ q (k, a) -> insertMin k a q) empty {-# RULES "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . fromList (build g) = g (uncurry' insert) empty; "fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . fromAscList (build g) = g (uncurry' insertMin) empty; #-} {-# INLINE keys #-} -- | /O(n log n)/. Return all keys of the queue in ascending order. keys :: Ord k => MinPQueue k a -> [k] keys = List.map fst . toAscList {-# INLINE elems #-} -- | /O(n log n)/. Return all elements of the queue in ascending order by key. elems :: Ord k => MinPQueue k a -> [a] elems = List.map snd . toAscList -- | /O(n log n)/. Return all (key, value) pairs in ascending order by key. toAscList :: Ord k => MinPQueue k a -> [(k, a)] toAscList = foldrWithKey (curry (:)) [] -- | /O(n log n)/. Return all (key, value) pairs in descending order by key. toDescList :: Ord k => MinPQueue k a -> [(k, a)] toDescList = foldlWithKey (\ z k a -> (k, a) : z) [] {-# RULES "toAscList" toAscList = \ q -> build (\ c n -> foldrWithKey (curry c) n q); "toDescList" toDescList = \ q -> build (\ c n -> foldlWithKey (\ z k a -> (k, a) `c` z) n q); "toListU" toListU = \ q -> build (\ c n -> foldrWithKeyU (curry c) n q); #-} {-# INLINE toList #-} -- | /O(n log n)/. Equivalent to 'toAscList'. -- -- If the traversal order is irrelevant, consider using 'toListU'. toList :: Ord k => MinPQueue k a -> [(k, a)] toList = toAscList {-# INLINE assocs #-} -- | /O(n log n)/. Equivalent to 'toAscList'. assocs :: Ord k => MinPQueue k a -> [(k, a)] assocs = toAscList {-# INLINE keysU #-} -- | /O(n)/. Return all keys of the queue in no particular order. keysU :: MinPQueue k a -> [k] keysU = List.map fst . toListU {-# INLINE elemsU #-} -- | /O(n)/. Return all elements of the queue in no particular order. elemsU :: MinPQueue k a -> [a] elemsU = List.map snd . toListU {-# INLINE assocsU #-} -- | /O(n)/. Equivalent to 'toListU'. assocsU :: MinPQueue k a -> [(k, a)] assocsU = toListU -- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order. toListU :: MinPQueue k a -> [(k, a)] toListU = foldrWithKeyU (curry (:)) [] -- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order. foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b foldrU = foldrWithKeyU . const -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order. foldlU :: (b -> a -> b) -> b -> MinPQueue k a -> b foldlU f = foldlWithKeyU (const . f) -- | /O(n)/. An unordered traversal over a priority queue, in no particular order. -- While there is no guarantee in which order the elements are traversed, the resulting -- priority queue will be perfectly valid. traverseU :: (Applicative f) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseU = traverseWithKeyU . const instance Functor (MinPQueue k) where fmap = map instance Ord k => Foldable (MinPQueue k) where foldr = foldrWithKey . const foldl f = foldlWithKey (const . f) instance Ord k => Traversable (MinPQueue k) where traverse = traverseWithKey . const pqueue-1.4.1.2/Data/PQueue/Prio/Internals.hs0000644000000000000000000004627713352773633016664 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.PQueue.Prio.Internals ( MinPQueue(..), BinomForest(..), BinomHeap, BinomTree(..), Zero(..), Succ(..), CompF, empty, null, size, singleton, insert, insertBehind, union, getMin, adjustMinWithKey, updateMinWithKey, minViewWithKey, mapWithKey, mapKeysMonotonic, mapMaybeWithKey, mapEitherWithKey, foldrWithKey, foldlWithKey, insertMin, foldrWithKeyU, foldlWithKeyU, traverseWithKeyU, seqSpine, mapForest ) where import Control.Applicative (Applicative(..), (<$>)) import Control.Applicative.Identity (Identity(Identity, runIdentity)) import Control.DeepSeq (NFData(rnf), deepseq) import Data.Monoid ((<>)) import Prelude hiding (null) #if __GLASGOW_HASKELL__ import Data.Data instance (Data k, Data a, Ord k) => Data (MinPQueue k a) where gfoldl f z m = z (foldr (uncurry' insertMin) empty) `f` foldrWithKey (curry (:)) [] m toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.PQueue.Prio.Min.MinPQueue" dataCast2 f = gcast2 f #endif (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (f .: g) x y = f (g x y) first' :: (a -> b) -> (a, c) -> (b, c) first' f (a, c) = (f a, c) second' :: (b -> c) -> (a, b) -> (a, c) second' f (a, b) = (a, f b) uncurry' :: (a -> b -> c) -> (a, b) -> c uncurry' f (a, b) = f a b infixr 8 .: -- | A priority queue where values of type @a@ are annotated with keys of type @k@. -- The queue supports extracting the element with minimum key. data MinPQueue k a = Empty | MinPQ {-# UNPACK #-} !Int k a (BinomHeap k a) #if __GLASGOW_HASKELL__ deriving (Typeable) #endif data BinomForest rk k a = Nil | Skip (BinomForest (Succ rk) k a) | Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a) type BinomHeap = BinomForest Zero data BinomTree rk k a = BinomTree k a (rk k a) data Zero k a = Zero data Succ rk k a = Succ {-# UNPACK #-} !(BinomTree rk k a) (rk k a) type CompF a = a -> a -> Bool instance (Ord k, Eq a) => Eq (MinPQueue k a) where MinPQ n1 k1 a1 ts1 == MinPQ n2 k2 a2 ts2 = n1 == n2 && eqExtract k1 a1 ts1 k2 a2 ts2 Empty == Empty = True _ == _ = False eqExtract :: (Ord k, Eq a) => k -> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool eqExtract k10 a10 ts10 k20 a20 ts20 = k10 == k20 && a10 == a20 && case (extract ts10, extract ts20) of (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2')) -> eqExtract k1 a1 ts1' k2 a2 ts2' (No, No) -> True _ -> False instance (Ord k, Ord a) => Ord (MinPQueue k a) where MinPQ _n1 k10 a10 ts10 `compare` MinPQ _n2 k20 a20 ts20 = cmpExtract k10 a10 ts10 k20 a20 ts20 Empty `compare` Empty = EQ Empty `compare` MinPQ{} = LT MinPQ{} `compare` Empty = GT cmpExtract :: (Ord k, Ord a) => k -> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Ordering cmpExtract k10 a10 ts10 k20 a20 ts20 = k10 `compare` k20 <> a10 `compare` a20 <> case (extract ts10, extract ts20) of (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2')) -> cmpExtract k1 a1 ts1' k2 a2 ts2' (No, Yes{}) -> LT (Yes{}, No) -> GT (No, No) -> EQ -- | /O(1)/. Returns the empty priority queue. empty :: MinPQueue k a empty = Empty -- | /O(1)/. Checks if this priority queue is empty. null :: MinPQueue k a -> Bool null Empty = True null _ = False -- | /O(1)/. Returns the size of this priority queue. size :: MinPQueue k a -> Int size Empty = 0 size (MinPQ n _ _ _) = n -- | /O(1)/. Constructs a singleton priority queue. singleton :: k -> a -> MinPQueue k a singleton k a = MinPQ 1 k a Nil -- | Amortized /O(1)/, worst-case /O(log n)/. Inserts -- an element with the specified key into the queue. insert :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a insert = insert' (<=) -- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy). -- Insert an element with the specified key into the priority queue, -- putting it behind elements whose key compares equal to the -- inserted one. insertBehind :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a insertBehind k v q = let (smaller, larger) = spanKey (<= k) q in foldr (uncurry insert) (insert k v larger) smaller spanKey :: Ord k => (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a) spanKey p q = case minViewWithKey q of Just (t@(k, _), q') | p k -> let (kas, q'') = spanKey p q' in (t : kas, q'') _ -> ([], q) -- | Internal helper method, using a specific comparator function. insert' :: CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a insert' _ k a Empty = singleton k a insert' le k a (MinPQ n k' a' ts) | k `le` k' = MinPQ (n+1) k a (incr le (tip k' a') ts) | otherwise = MinPQ (n+1) k' a' (incr le (tip k a ) ts) -- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union -- of the two specified queues. union :: Ord k => MinPQueue k a -> MinPQueue k a -> MinPQueue k a union = union' (<=) -- | Takes the union of the two specified queues, using the given comparison function. union' :: CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a union' le (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2) | k1 `le` k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2) | otherwise = MinPQ (n1 + n2) k2 a2 (insMerge k1 a1) where insMerge k a = carryForest le (tip k a) ts1 ts2 union' _ Empty q2 = q2 union' _ q1 Empty = q1 -- | /O(1)/. The minimal (key, element) in the queue, if the queue is nonempty. getMin :: MinPQueue k a -> Maybe (k, a) getMin (MinPQ _ k a _) = Just (k, a) getMin _ = Nothing -- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing. adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a adjustMinWithKey _ Empty = Empty adjustMinWithKey f (MinPQ n k a ts) = MinPQ n k (f k a) ts -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key. -- If the queue is empty, does nothing. updateMinWithKey :: Ord k => (k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a updateMinWithKey _ Empty = Empty updateMinWithKey f (MinPQ n k a ts) = case f k a of Nothing -> extractHeap (<=) n ts Just a' -> MinPQ n k a' ts -- | /O(log n)/. Retrieves the minimal (key, value) pair of the map, and the map stripped of that -- element, or 'Nothing' if passed an empty map. minViewWithKey :: Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a) minViewWithKey Empty = Nothing minViewWithKey (MinPQ n k a ts) = Just ((k, a), extractHeap (<=) n ts) -- | /O(n)/. Map a function over all values in the queue. mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b mapWithKey f = runIdentity . traverseWithKeyU (Identity .: f) -- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly -- monotonic. /The precondition is not checked./ This function has better performance than -- 'mapKeys'. mapKeysMonotonic :: (k -> k') -> MinPQueue k a -> MinPQueue k' a mapKeysMonotonic _ Empty = Empty mapKeysMonotonic f (MinPQ n k a ts) = MinPQ n (f k) a (mapKeysMonoF f (const Zero) ts) -- | /O(n)/. Map values and collect the 'Just' results. mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b mapMaybeWithKey _ Empty = Empty mapMaybeWithKey f (MinPQ _ k a ts) = maybe id (insert k) (f k a) (mapMaybeF (<=) f (const Empty) ts) -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c) mapEitherWithKey _ Empty = (Empty, Empty) mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a) (mapEitherF (<=) f (const (Empty, Empty)) ts) -- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@. -- -- If you do not care about the traversal order, consider using 'foldrWithKeyU'. foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MinPQueue k a -> b foldrWithKey _ z Empty = z foldrWithKey f z (MinPQ _ k0 a0 ts0) = f k0 a0 (foldF ts0) where foldF ts = case extract ts of Yes (Extract k a _ ts') -> f k a (foldF ts') _ -> z -- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@. -- -- If you do not care about the traversal order, consider using 'foldlWithKeyU'. foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MinPQueue k a -> b foldlWithKey _ z Empty = z foldlWithKey f z0 (MinPQ _ k0 a0 ts0) = foldF (f z0 k0 a0) ts0 where foldF z ts = case extract ts of Yes (Extract k a _ ts') -> foldF (f z k a) ts' _ -> z -- | Equivalent to 'insert', save the assumption that this key is @<=@ -- every other key in the map. /The precondition is not checked./ insertMin :: k -> a -> MinPQueue k a -> MinPQueue k a insertMin k a Empty = MinPQ 1 k a Nil insertMin k a (MinPQ n k' a' ts) = MinPQ (n+1) k a (incrMin (tip k' a') ts) -- | /O(1)/. Returns a binomial tree of rank zero containing this -- key and value. tip :: k -> a -> BinomTree Zero k a tip k a = BinomTree k a Zero -- | /O(1)/. Takes the union of two binomial trees of the same rank. meld :: CompF k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a meld le t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2) | k1 `le` k2 = BinomTree k1 v1 (Succ t2 ts1) | otherwise = BinomTree k2 v2 (Succ t1 ts2) -- | Takes the union of two binomial forests, starting at the same rank. Analogous to binary addition. mergeForest :: CompF k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a mergeForest le f1 f2 = case (f1, f2) of (Skip ts1, Skip ts2) -> Skip (mergeForest le ts1 ts2) (Skip ts1, Cons t2 ts2) -> Cons t2 (mergeForest le ts1 ts2) (Cons t1 ts1, Skip ts2) -> Cons t1 (mergeForest le ts1 ts2) (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest le (meld le t1 t2) ts1 ts2) (Nil, _) -> f2 (_, Nil) -> f1 -- | Takes the union of two binomial forests, starting at the same rank, with an additional tree. -- Analogous to binary addition when a digit has been carried. carryForest :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a carryForest le t0 f1 f2 = t0 `seq` case (f1, f2) of (Cons t1 ts1, Cons t2 ts2) -> Cons t0 (carryMeld t1 t2 ts1 ts2) (Cons t1 ts1, Skip ts2) -> Skip (carryMeld t0 t1 ts1 ts2) (Skip ts1, Cons t2 ts2) -> Skip (carryMeld t0 t2 ts1 ts2) (Skip ts1, Skip ts2) -> Cons t0 (mergeForest le ts1 ts2) (Nil, _) -> incr le t0 f2 (_, Nil) -> incr le t0 f1 where carryMeld = carryForest le .: meld le -- | Inserts a binomial tree into a binomial forest. Analogous to binary incrementation. incr :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a incr le t ts = t `seq` case ts of Nil -> Cons t Nil Skip ts' -> Cons t ts' Cons t' ts' -> Skip (incr le (meld le t t') ts') -- | Inserts a binomial tree into a binomial forest. Assumes that the root of this tree -- is less than all other roots. Analogous to binary incrementation. Equivalent to -- @'incr' (\ _ _ -> True)@. incrMin :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a incrMin t@(BinomTree k a ts) tss = case tss of Nil -> Cons t Nil Skip tss' -> Cons t tss' Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss') extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a extractHeap le n ts = n `seq` case extractForest le ts of No -> Empty Yes (Extract k a _ ts') -> MinPQ (n-1) k a ts' -- | A specialized type intended to organize the return of extract-min queries -- from a binomial forest. We walk all the way through the forest, and then -- walk backwards. @Extract rk a@ is the result type of an extract-min -- operation that has walked as far backwards of rank @rk@ -- that is, it -- has visited every root of rank @>= rk@. -- -- The interpretation of @Extract minKey minVal children forest@ is -- -- * @minKey@ is the key of the minimum root visited so far. It may have -- any rank @>= rk@. We will denote the root corresponding to -- @minKey@ as @minRoot@. -- -- * @minVal@ is the value corresponding to @minKey@. -- -- * @children@ is those children of @minRoot@ which have not yet been -- merged with the rest of the forest. Specifically, these are -- the children with rank @< rk@. -- -- * @forest@ is an accumulating parameter that maintains the partial -- reconstruction of the binomial forest without @minRoot@. It is -- the union of all old roots with rank @>= rk@ (except @minRoot@), -- with the set of all children of @minRoot@ with rank @>= rk@. -- Note that @forest@ is lazy, so if we discover a smaller key -- than @minKey@ later, we haven't wasted significant work. data Extract rk k a = Extract k a (rk k a) (BinomForest rk k a) data MExtract rk k a = No | Yes {-# UNPACK #-} !(Extract rk k a) incrExtract :: CompF k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a incrExtract _ Nothing (Extract k a (Succ t ts) tss) = Extract k a ts (Cons t tss) incrExtract le (Just t) (Extract k a (Succ t' ts) tss) = Extract k a ts (Skip (incr le (meld le t t') tss)) -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress. Each successive application of @extractBin@ takes -- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a extractForest _ Nil = No extractForest le (Skip tss) = case extractForest le tss of No -> No Yes ex -> Yes (incrExtract le Nothing ex) extractForest le (Cons t@(BinomTree k a0 ts) tss) = Yes $ case extractForest le tss of Yes ex@(Extract k' _ _ _) | k' incrExtract le (Just t) ex _ -> Extract k a0 ts (Skip tss) where a BinomForest rk k a -> MExtract rk k a extract = extractForest (<=) -- | Utility function for mapping over a forest. mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b mapForest f fCh ts0 = case ts0 of Nil -> Nil Skip ts' -> Skip (mapForest f fCh' ts') Cons (BinomTree k a ts) tss -> Cons (BinomTree k (f k a) (fCh ts)) (mapForest f fCh' tss) where fCh' (Succ (BinomTree k a ts) tss) = Succ (BinomTree k (f k a) (fCh ts)) (fCh tss) -- | Utility function for mapping a 'Maybe' function over a forest. mapMaybeF :: CompF k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) -> BinomForest rk k a -> MinPQueue k b mapMaybeF le f fCh ts0 = case ts0 of Nil -> Empty Skip ts' -> mapMaybeF le f fCh' ts' Cons (BinomTree k a ts) ts' -> insF k a (fCh ts) (mapMaybeF le f fCh' ts') where insF k a = maybe id (insert' le k) (f k a) .: union' le fCh' (Succ (BinomTree k a ts) tss) = insF k a (fCh ts) (fCh tss) -- | Utility function for mapping an 'Either' function over a forest. mapEitherF :: CompF k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) -> BinomForest rk k a -> (MinPQueue k b, MinPQueue k c) mapEitherF le f0 fCh ts0 = case ts0 of Nil -> (Empty, Empty) Skip ts' -> mapEitherF le f0 fCh' ts' Cons (BinomTree k a ts) ts' -> insF k a (fCh ts) (mapEitherF le f0 fCh' ts') where insF k a = either (first' . insert' le k) (second' . insert' le k) (f0 k a) .: (union' le `both` union' le) fCh' (Succ (BinomTree k a ts) tss) = insF k a (fCh ts) (fCh tss) both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2) -- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order. foldrWithKeyU :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b foldrWithKeyU _ z Empty = z foldrWithKeyU f z (MinPQ _ k a ts) = f k a (foldrWithKeyF_ f (const id) ts z) -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b foldlWithKeyU _ z Empty = z foldlWithKeyU f z0 (MinPQ _ k0 a0 ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z0 k0 a0) traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseWithKeyU _ Empty = pure Empty traverseWithKeyU f (MinPQ n k a ts) = MinPQ n k <$> f k a <*> traverseForest f (const (pure Zero)) ts {-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a -> Identity (BinomForest rk k b) #-} traverseForest :: (Applicative f) => (k -> a -> f b) -> (rk k a -> f (rk k b)) -> BinomForest rk k a -> f (BinomForest rk k b) traverseForest f fCh ts0 = case ts0 of Nil -> pure Nil Skip ts' -> Skip <$> traverseForest f fCh' ts' Cons (BinomTree k a ts) tss -> Cons <$> (BinomTree k <$> f k a <*> fCh ts) <*> traverseForest f fCh' tss where fCh' (Succ (BinomTree k a ts) tss) = Succ <$> (BinomTree k <$> f k a <*> fCh ts) <*> fCh tss -- | Unordered right fold on a binomial forest. foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b foldrWithKeyF_ f fCh ts0 z0 = case ts0 of Nil -> z0 Skip ts' -> foldrWithKeyF_ f fCh' ts' z0 Cons (BinomTree k a ts) ts' -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z0)) where fCh' (Succ (BinomTree k a ts) tss) z = f k a (fCh ts (fCh tss z)) -- | Unordered left fold on a binomial forest. foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b foldlWithKeyF_ f fCh ts0 = case ts0 of Nil -> id Skip ts' -> foldlWithKeyF_ f fCh' ts' Cons (BinomTree k a ts) ts' -> foldlWithKeyF_ f fCh' ts' . fCh ts . f k a where fCh' (Succ (BinomTree k a ts) tss) = fCh tss . fCh ts . f k a -- | Maps a monotonic function over the keys in a binomial forest. mapKeysMonoF :: (k -> k') -> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a mapKeysMonoF f fCh ts0 = case ts0 of Nil -> Nil Skip ts' -> Skip (mapKeysMonoF f fCh' ts') Cons (BinomTree k a ts) ts' -> Cons (BinomTree (f k) a (fCh ts)) (mapKeysMonoF f fCh' ts') where fCh' (Succ (BinomTree k a ts) tss) = Succ (BinomTree (f k) a (fCh ts)) (fCh tss) -- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap. seqSpine :: MinPQueue k a -> b -> b seqSpine Empty z0 = z0 seqSpine (MinPQ _ _ _ ts0) z0 = ts0 `seqSpineF` z0 where seqSpineF :: BinomForest rk k a -> b -> b seqSpineF ts z = case ts of Nil -> z Skip ts' -> seqSpineF ts' z Cons _ ts' -> seqSpineF ts' z class NFRank rk where rnfRk :: (NFData k, NFData a) => rk k a -> () instance NFRank Zero where rnfRk _ = () instance NFRank rk => NFRank (Succ rk) where rnfRk (Succ t ts) = t `deepseq` rnfRk ts instance (NFData k, NFData a, NFRank rk) => NFData (BinomTree rk k a) where rnf (BinomTree k a ts) = k `deepseq` a `deepseq` rnfRk ts instance (NFData k, NFData a, NFRank rk) => NFData (BinomForest rk k a) where rnf Nil = () rnf (Skip tss) = rnf tss rnf (Cons t tss) = t `deepseq` rnf tss instance (NFData k, NFData a) => NFData (MinPQueue k a) where rnf Empty = () rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts pqueue-1.4.1.2/Data/PQueue/Prio/Max.hs0000644000000000000000000004423713352773633015444 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.PQueue.Prio.Max -- Copyright : (c) Louis Wasserman 2010 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- General purpose priority queue. -- Each element is associated with a /key/, and the priority queue supports -- viewing and extracting the element with the maximum key. -- -- A worst-case bound is given for each operation. In some cases, an amortized -- bound is also specified; these bounds do not hold in a persistent context. -- -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily. To force the spine of the heap, -- use 'seqSpine'. -- -- We do not guarantee stable behavior. -- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there -- are no guarantees about the relative order in which @k1@, @k2@, and their associated -- elements are returned. (Unlike Data.Map, we allow multiple elements with the -- same key.) -- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. ----------------------------------------------------------------------------- module Data.PQueue.Prio.Max ( MaxPQueue, -- * Construction empty, singleton, insert, insertBehind, union, unions, -- * Query null, size, -- ** Maximum view findMax, getMax, deleteMax, deleteFindMax, adjustMax, adjustMaxWithKey, updateMax, updateMaxWithKey, maxView, maxViewWithKey, -- * Traversal -- ** Map map, mapWithKey, mapKeys, mapKeysMonotonic, -- ** Fold foldrWithKey, foldlWithKey, -- ** Traverse traverseWithKey, -- * Subsets -- ** Indexed take, drop, splitAt, -- ** Predicates takeWhile, takeWhileWithKey, dropWhile, dropWhileWithKey, span, spanWithKey, break, breakWithKey, -- *** Filter filter, filterWithKey, partition, partitionWithKey, mapMaybe, mapMaybeWithKey, mapEither, mapEitherWithKey, -- * List operations -- ** Conversion from lists fromList, fromAscList, fromDescList, -- ** Conversion to lists keys, elems, assocs, toAscList, toDescList, toList, -- * Unordered operations foldrU, foldrWithKeyU, foldlU, foldlWithKeyU, traverseU, traverseWithKeyU, keysU, elemsU, assocsU, toListU, -- * Helper methods seqSpine ) where import Control.Applicative (Applicative, (<$>)) import Data.Monoid (Monoid(mempty, mappend, mconcat)) import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable, foldr, foldl) import Data.Maybe (fromMaybe) import Data.PQueue.Prio.Max.Internals #if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup((<>))) #endif import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl) import qualified Data.PQueue.Prio.Min as Q #ifdef __GLASGOW_HASKELL__ import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] #endif first' :: (a -> b) -> (a, c) -> (b, c) first' f (a, c) = (f a, c) #if MIN_VERSION_base(4,9,0) instance Ord k => Semigroup (MaxPQueue k a) where (<>) = union #endif instance Ord k => Monoid (MaxPQueue k a) where mempty = empty mappend = union mconcat = unions instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where showsPrec p xs = showParen (p > 10) $ showString "fromDescList " . shows (toDescList xs) instance (Read k, Read a) => Read (MaxPQueue k 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 Functor (MaxPQueue k) where fmap f (MaxPQ q) = MaxPQ (fmap f q) instance Ord k => Foldable (MaxPQueue k) where foldr f z (MaxPQ q) = foldr f z q foldl f z (MaxPQ q) = foldl f z q instance Ord k => Traversable (MaxPQueue k) where traverse f (MaxPQ q) = MaxPQ <$> traverse f q -- | /O(1)/. Returns the empty priority queue. empty :: MaxPQueue k a empty = MaxPQ Q.empty -- | /O(1)/. Constructs a singleton priority queue. singleton :: k -> a -> MaxPQueue k a singleton k a = MaxPQ (Q.singleton (Down k) a) -- | Amortized /O(1)/, worst-case /O(log n)/. Inserts -- an element with the specified key into the queue. insert :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a insert k a (MaxPQ q) = MaxPQ (Q.insert (Down k) a q) -- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy). -- Insert an element with the specified key into the priority queue, -- putting it behind elements whose key compares equal to the -- inserted one. insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q) -- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union -- of the two specified queues. union :: Ord k => MaxPQueue k a -> MaxPQueue k a -> MaxPQueue k a MaxPQ q1 `union` MaxPQ q2 = MaxPQ (q1 `Q.union` q2) -- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@). unions :: Ord k => [MaxPQueue k a] -> MaxPQueue k a unions qs = MaxPQ (Q.unions [q | MaxPQ q <- qs]) -- | /O(1)/. Checks if this priority queue is empty. null :: MaxPQueue k a -> Bool null (MaxPQ q) = Q.null q -- | /O(1)/. Returns the size of this priority queue. size :: MaxPQueue k a -> Int size (MaxPQ q) = Q.size q -- | /O(1)/. The maximal (key, element) in the queue. Calls 'error' if empty. findMax :: MaxPQueue k a -> (k, a) findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax -- | /O(1)/. The maximal (key, element) in the queue, if the queue is nonempty. getMax :: MaxPQueue k a -> Maybe (k, a) getMax (MaxPQ q) = do (Down k, a) <- Q.getMin q return (k, a) -- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty. deleteMax :: Ord k => MaxPQueue k a -> MaxPQueue k a deleteMax (MaxPQ q) = MaxPQ (Q.deleteMin q) -- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty. deleteFindMax :: Ord k => MaxPQueue k a -> ((k, a), MaxPQueue k a) deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey -- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing. adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a adjustMax = adjustMaxWithKey . const -- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing. adjustMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a adjustMaxWithKey f (MaxPQ q) = MaxPQ (Q.adjustMinWithKey (f . unDown) q) -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key. -- If the queue is empty, does nothing. updateMax :: Ord k => (a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a updateMax = updateMaxWithKey . const -- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key. -- If the queue is empty, does nothing. updateMaxWithKey :: Ord k => (k -> a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a updateMaxWithKey f (MaxPQ q) = MaxPQ (Q.updateMinWithKey (f . unDown) q) -- | /O(log n)/. Retrieves the value associated with the maximum key of the queue, and the queue -- stripped of that element, or 'Nothing' if passed an empty queue. maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a) maxView q = do ((_, a), q') <- maxViewWithKey q return (a, q') -- | /O(log n)/. Retrieves the maximal (key, value) pair of the map, and the map stripped of that -- element, or 'Nothing' if passed an empty map. maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a) maxViewWithKey (MaxPQ q) = do ((Down k, a), q') <- Q.minViewWithKey q return ((k, a), MaxPQ q') -- | /O(n)/. Map a function over all values in the queue. map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b map = mapWithKey . const -- | /O(n)/. Map a function over all values in the queue. mapWithKey :: (k -> a -> b) -> MaxPQueue k a -> MaxPQueue k b mapWithKey f (MaxPQ q) = MaxPQ (Q.mapWithKey (f . unDown) q) -- | /O(n)/. Map a function over all values in the queue. mapKeys :: Ord k' => (k -> k') -> MaxPQueue k a -> MaxPQueue k' a mapKeys f (MaxPQ q) = MaxPQ (Q.mapKeys (fmap f) q) -- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly -- monotonic. /The precondition is not checked./ This function has better performance than -- 'mapKeys'. mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q) -- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@. -- -- If you do not care about the traversal order, consider using 'foldrWithKeyU'. foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q -- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toDescList' q)@. -- -- If you do not care about the traversal order, consider using 'foldlWithKeyU'. foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (\ z -> f z . unDown) z0 q -- | /O(n log n)/. Traverses the elements of the queue in descending order by key. -- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@) -- -- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'. traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b) traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q -- | /O(k log n)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@. -- (@'take' k q == 'List.take' k ('toDescList' q)@) take :: Ord k => Int -> MaxPQueue k a -> [(k, a)] take k (MaxPQ q) = fmap (first' unDown) (Q.take k q) -- | /O(k log n)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@. drop :: Ord k => Int -> MaxPQueue k a -> MaxPQueue k a drop k (MaxPQ q) = MaxPQ (Q.drop k q) -- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@. splitAt :: Ord k => Int -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) splitAt k (MaxPQ q) = case Q.splitAt k q of (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@) takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)] takeWhile = takeWhileWithKey . const -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toDescList' q)@) takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> [(k, a)] takeWhileWithKey p (MaxPQ q) = fmap (first' unDown) (Q.takeWhileWithKey (p . unDown) q) -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a dropWhile = dropWhileWithKey . const -- | Removes the longest possible prefix of elements satisfying the predicate. dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a dropWhileWithKey p (MaxPQ q) = MaxPQ (Q.dropWhileWithKey (p . unDown) q) -- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@. span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) span = spanWithKey . const -- | Equivalent to @'span' ('not' . p)@. break :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) break = breakWithKey . const -- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@. spanWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) spanWithKey p (MaxPQ q) = case Q.spanWithKey (p . unDown) q of (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | Equivalent to @'spanWithKey' (\ k a -> 'not' (p k a)) q@. breakWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a) breakWithKey p (MaxPQ q) = case Q.breakWithKey (p . unDown) q of (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | /O(n)/. Filter all values that satisfy the predicate. filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a filter = filterWithKey . const -- | /O(n)/. Filter all values that satisfy the predicate. filterWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a filterWithKey p (MaxPQ q) = MaxPQ (Q.filterWithKey (p . unDown) q) -- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements -- which satisfy the predicate, the second all elements that fail the predicate. partition :: Ord k => (a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a) partition = partitionWithKey . const -- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements -- which satisfy the predicate, the second all elements that fail the predicate. partitionWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a) partitionWithKey p (MaxPQ q) = case Q.partitionWithKey (p . unDown) q of (q1, q0) -> (MaxPQ q1, MaxPQ q0) -- | /O(n)/. Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b mapMaybe = mapMaybeWithKey . const -- | /O(n)/. Map values and collect the 'Just' results. mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b mapMaybeWithKey f (MaxPQ q) = MaxPQ (Q.mapMaybeWithKey (f . unDown) q) -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEither :: Ord k => (a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c) mapEither = mapEitherWithKey . const -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c) mapEitherWithKey f (MaxPQ q) = case Q.mapEitherWithKey (f . unDown) q of (qL, qR) -> (MaxPQ qL, MaxPQ qR) -- | /O(n)/. Build a priority queue from the list of (key, value) pairs. fromList :: Ord k => [(k, a)] -> MaxPQueue k a fromList = MaxPQ . Q.fromList . fmap (first' Down) -- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./ fromAscList :: [(k, a)] -> MaxPQueue k a fromAscList = MaxPQ . Q.fromDescList . fmap (first' Down) -- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./ fromDescList :: [(k, a)] -> MaxPQueue k a fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down) -- | /O(n log n)/. Return all keys of the queue in descending order. keys :: Ord k => MaxPQueue k a -> [k] keys = fmap fst . toDescList -- | /O(n log n)/. Return all elements of the queue in descending order by key. elems :: Ord k => MaxPQueue k a -> [a] elems = fmap snd . toDescList -- | /O(n log n)/. Equivalent to 'toDescList'. assocs :: Ord k => MaxPQueue k a -> [(k, a)] assocs = toDescList -- | /O(n log n)/. Return all (key, value) pairs in ascending order by key. toAscList :: Ord k => MaxPQueue k a -> [(k, a)] toAscList (MaxPQ q) = fmap (first' unDown) (Q.toDescList q) -- | /O(n log n)/. Return all (key, value) pairs in descending order by key. toDescList :: Ord k => MaxPQueue k a -> [(k, a)] toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q) -- | /O(n log n)/. Equivalent to 'toDescList'. -- -- If the traversal order is irrelevant, consider using 'toListU'. toList :: Ord k => MaxPQueue k a -> [(k, a)] toList = toDescList -- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order. foldrU :: (a -> b -> b) -> b -> MaxPQueue k a -> b foldrU = foldrWithKeyU . const -- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order. foldrWithKeyU :: (k -> a -> b -> b) -> b -> MaxPQueue k a -> b foldrWithKeyU f z (MaxPQ q) = Q.foldrWithKeyU (f . unDown) z q -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order. foldlU :: (b -> a -> b) -> b -> MaxPQueue k a -> b foldlU f = foldlWithKeyU (const . f) -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z0 q -- | /O(n)/. An unordered traversal over a priority queue, in no particular order. -- While there is no guarantee in which order the elements are traversed, the resulting -- priority queue will be perfectly valid. traverseU :: (Applicative f) => (a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b) traverseU = traverseWithKeyU . const -- | /O(n)/. An unordered traversal over a priority queue, in no particular order. -- While there is no guarantee in which order the elements are traversed, the resulting -- priority queue will be perfectly valid. traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b) traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q -- | /O(n)/. Return all keys of the queue in no particular order. keysU :: MaxPQueue k a -> [k] keysU = fmap fst . toListU -- | /O(n)/. Return all elements of the queue in no particular order. elemsU :: MaxPQueue k a -> [a] elemsU = fmap snd . toListU -- | /O(n)/. Equivalent to 'toListU'. assocsU :: MaxPQueue k a -> [(k, a)] assocsU = toListU -- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order. toListU :: MaxPQueue k a -> [(k, a)] toListU (MaxPQ q) = fmap (first' unDown) (Q.toListU q) -- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap. seqSpine :: MaxPQueue k a -> b -> b seqSpine (MaxPQ q) = Q.seqSpine q pqueue-1.4.1.2/Data/PQueue/Prio/Max/0000755000000000000000000000000013352773633015076 5ustar0000000000000000pqueue-1.4.1.2/Data/PQueue/Prio/Max/Internals.hs0000644000000000000000000000240713352773633017374 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.PQueue.Prio.Max.Internals where import Control.DeepSeq (NFData(rnf)) import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable(foldr, foldl)) import Data.Functor ((<$>)) # if __GLASGOW_HASKELL__ import Data.Data (Data, Typeable) # endif import Prelude hiding (foldr, foldl) import Data.PQueue.Prio.Internals (MinPQueue) newtype Down a = Down {unDown :: a} # if __GLASGOW_HASKELL__ deriving (Eq, Data, Typeable) # else deriving (Eq) # endif -- | A priority queue where values of type @a@ are annotated with keys of type @k@. -- The queue supports extracting the element with maximum key. newtype MaxPQueue k a = MaxPQ (MinPQueue (Down k) a) # if __GLASGOW_HASKELL__ deriving (Eq, Ord, Data, Typeable) # else deriving (Eq, Ord) # endif instance (NFData k, NFData a) => NFData (MaxPQueue k a) where rnf (MaxPQ q) = rnf q instance NFData a => NFData (Down a) where rnf (Down a) = rnf a instance Ord a => Ord (Down a) where Down a `compare` Down b = b `compare` a Down a <= Down b = b <= a instance Functor Down where fmap f (Down a) = Down (f a) instance 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 pqueue-1.4.1.2/include/0000755000000000000000000000000013352773633013006 5ustar0000000000000000pqueue-1.4.1.2/include/Typeable.h0000644000000000000000000000444213352773633014730 0ustar0000000000000000{- -------------------------------------------------------------------------- // Macros to help make Typeable instances. // // INSTANCE_TYPEABLEn(tc,tcname,"tc") defines // // instance Typeable/n/ tc // instance Typeable a => Typeable/n-1/ (tc a) // instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b) // ... // instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an) // -------------------------------------------------------------------------- -} #ifndef TYPEABLE_H #define TYPEABLE_H #define INSTANCE_TYPEABLE0(tycon,tcname,str) \ tcname :: TyCon; \ tcname = mkTyCon str; \ instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] } #ifdef __GLASGOW_HASKELL__ -- // For GHC, the extra instances follow from general instance declarations -- // defined in Data.Typeable. #define INSTANCE_TYPEABLE1(tycon,tcname,str) \ tcname :: TyCon; \ tcname = mkTyCon str; \ instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] } #define INSTANCE_TYPEABLE2(tycon,tcname,str) \ tcname :: TyCon; \ tcname = mkTyCon str; \ instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] } #define INSTANCE_TYPEABLE3(tycon,tcname,str) \ tcname :: TyCon; \ tcname = mkTyCon str; \ instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] } #else /* !__GLASGOW_HASKELL__ */ #define INSTANCE_TYPEABLE1(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault } #define INSTANCE_TYPEABLE2(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable1 (tycon a) where { \ typeOf1 = typeOf1Default }; \ instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \ typeOf = typeOfDefault } #define INSTANCE_TYPEABLE3(tycon,tcname,str) \ tcname = mkTyCon str; \ instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable2 (tycon a) where { \ typeOf2 = typeOf2Default }; \ instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \ typeOf1 = typeOf1Default }; \ instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \ typeOf = typeOfDefault } #endif /* !__GLASGOW_HASKELL__ */ #endif pqueue-1.4.1.2/Control/0000755000000000000000000000000013352773633013003 5ustar0000000000000000pqueue-1.4.1.2/Control/Applicative/0000755000000000000000000000000013352773633015244 5ustar0000000000000000pqueue-1.4.1.2/Control/Applicative/Identity.hs0000644000000000000000000000046413352773633017375 0ustar0000000000000000module Control.Applicative.Identity where import Control.Applicative import Prelude newtype Identity a = Identity {runIdentity :: a} instance Functor Identity where fmap f (Identity x) = Identity (f x) instance Applicative Identity where pure = Identity Identity f <*> Identity x = Identity (f x)