{-# 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