{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- 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.
--
-- 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,
  foldlU',
  foldMapU,
  elemsU,
  toListU,
  -- * Miscellaneous operations
  keysQueue,
  seqSpine) where

import Prelude hiding (null, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map)

import Data.Foldable (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
import qualified BinomialQueue.Internals as BQ
import qualified Data.PQueue.Prio.Internals as Prio

#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
#else
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif

-- | \(O(1)\). Returns the minimum element. Throws an error on an empty queue.
findMin :: MinQueue a -> a
findMin :: MinQueue a -> a
findMin = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Error: findMin called on empty queue") (Maybe a -> a) -> (MinQueue a -> Maybe a) -> MinQueue a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinQueue a -> Maybe a
forall a. MinQueue a -> Maybe a
getMin

-- | \(O(\log n)\). Deletes the minimum element. If the queue is empty, does nothing.
deleteMin :: Ord a => MinQueue a -> MinQueue a
deleteMin :: MinQueue a -> MinQueue a
deleteMin MinQueue a
q = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
q of
  Maybe (a, MinQueue a)
Nothing      -> MinQueue a
forall a. MinQueue a
empty
  Just (a
_, MinQueue a
q') -> MinQueue a
q'

-- | \(O(\log n)\). Extracts the minimum element. Throws an error on an empty queue.
deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)
deleteFindMin :: MinQueue a -> (a, MinQueue a)
deleteFindMin = (a, MinQueue a) -> Maybe (a, MinQueue a) -> (a, MinQueue a)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (a, MinQueue a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Error: deleteFindMin called on empty queue") (Maybe (a, MinQueue a) -> (a, MinQueue a))
-> (MinQueue a -> Maybe (a, MinQueue a))
-> MinQueue a
-> (a, MinQueue a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView

-- | \(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
MinQueue a
q !! :: MinQueue a -> Int -> a
!! Int
n  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= MinQueue a -> Int
forall a. MinQueue a -> Int
size MinQueue a
q
    = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.PQueue.Min.!!: index too large"
MinQueue a
q !! Int
n = [a] -> Int -> a
forall a. [a] -> Int -> a
(List.!!) (MinQueue a -> [a]
forall a. Ord a => MinQueue a -> [a]
toAscList MinQueue a
q) Int
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 :: (a -> Bool) -> MinQueue a -> [a]
takeWhile a -> Bool
p = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
foldWhileFB a -> Bool
p ([a] -> [a]) -> (MinQueue a -> [a]) -> MinQueue a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinQueue a -> [a]
forall a. Ord a => MinQueue a -> [a]
toAscList

{-# INLINE foldWhileFB #-}
-- | Equivalent to Data.List.takeWhile, but is a better producer.
foldWhileFB :: (a -> Bool) -> [a] -> [a]
foldWhileFB :: (a -> Bool) -> [a] -> [a]
foldWhileFB a -> Bool
p [a]
xs0 = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
nil -> let
  consWhile :: a -> b -> b
consWhile a
x b
xs
    | a -> Bool
p a
x    = a
x a -> b -> b
`c` b
xs
    | Bool
otherwise  = b
nil
  in (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
consWhile b
nil [a]
xs0)

-- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.
dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a
dropWhile :: (a -> Bool) -> MinQueue a -> MinQueue a
dropWhile a -> Bool
p = MinQueue a -> MinQueue a
drop' where
  drop' :: MinQueue a -> MinQueue a
drop' MinQueue a
q = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
q of
    Just (a
x, MinQueue a
q') | a -> Bool
p a
x -> MinQueue a -> MinQueue a
drop' MinQueue a
q'
    Maybe (a, MinQueue a)
_                  -> MinQueue a
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 :: (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
span a -> Bool
p MinQueue a
queue = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
queue of
  Just (a
x, MinQueue a
q')
    | a -> Bool
p a
x  -> let ([a]
ys, MinQueue a
q'') = (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
forall a. Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
span a -> Bool
p MinQueue a
q' in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys, MinQueue a
q'')
  Maybe (a, MinQueue a)
_        -> ([], MinQueue a
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 :: (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
break a -> Bool
p = (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
forall a. Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
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 :: Int -> MinQueue a -> [a]
take Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
List.take Int
n ([a] -> [a]) -> (MinQueue a -> [a]) -> MinQueue a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinQueue a -> [a]
forall a. Ord a => MinQueue a -> [a]
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 :: Int -> MinQueue a -> MinQueue a
drop Int
n MinQueue a
queue = Int
n Int -> MinQueue a -> MinQueue a
`seq` case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
queue of
  Just (a
_, MinQueue a
queue')
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  -> Int -> MinQueue a -> MinQueue a
forall a. Ord a => Int -> MinQueue a -> MinQueue a
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MinQueue a
queue'
  Maybe (a, MinQueue a)
_          -> MinQueue a
queue

-- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k queue)@.
splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)
splitAt :: Int -> MinQueue a -> ([a], MinQueue a)
splitAt Int
n MinQueue a
queue = Int
n Int -> ([a], MinQueue a) -> ([a], MinQueue a)
`seq` case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
queue of
  Just (a
x, MinQueue a
queue')
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  -> let ([a]
xs, MinQueue a
queue'') = Int -> MinQueue a -> ([a], MinQueue a)
forall a. Ord a => Int -> MinQueue a -> ([a], MinQueue a)
splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MinQueue a
queue' in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, MinQueue a
queue'')
  Maybe (a, MinQueue a)
_          -> ([], MinQueue a
queue)

-- | \(O(n)\). Returns the queue with all elements not satisfying @p@ removed.
filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a
filter :: (a -> Bool) -> MinQueue a -> MinQueue a
filter a -> Bool
p = (a -> Maybe a) -> MinQueue a -> MinQueue a
forall b a. Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe (\a
x -> if a -> Bool
p a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
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 :: (a -> Bool) -> MinQueue a -> (MinQueue a, MinQueue a)
partition a -> Bool
p = (a -> Either a a) -> MinQueue a -> (MinQueue a, MinQueue a)
forall b c a.
(Ord b, Ord c) =>
(a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither (\a
x -> if a -> Bool
p a
x then a -> Either a a
forall a b. a -> Either a b
Left a
x else a -> Either a a
forall a b. b -> Either a b
Right a
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 :: (a -> b) -> MinQueue a -> MinQueue b
map a -> b
f = (a -> MinQueue b -> MinQueue b)
-> MinQueue b -> MinQueue a -> MinQueue b
forall a b. (a -> b -> b) -> b -> MinQueue a -> b
foldrU (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
insert (b -> MinQueue b -> MinQueue b)
-> (a -> b) -> a -> MinQueue b -> MinQueue b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) MinQueue b
forall a. MinQueue a
empty

{-# 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 :: MinQueue a -> [a]
toList = MinQueue a -> [a]
forall a. Ord a => MinQueue a -> [a]
toAscList

-- | \(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 :: (b -> a -> b) -> b -> MinQueue a -> b
foldlDesc = (a -> b -> b) -> b -> MinQueue a -> b
forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc ((a -> b -> b) -> b -> MinQueue a -> b)
-> ((b -> a -> b) -> a -> b -> b)
-> (b -> a -> b)
-> b
-> MinQueue a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip

{-# INLINE fromDescList #-}
-- | \(O(n)\). Constructs a priority queue from an descending list. /Warning/: Does not check the precondition.
fromDescList :: [a] -> MinQueue a
-- We apply an explicit argument to get foldl' to inline.
fromDescList :: [a] -> MinQueue a
fromDescList [a]
xs = (MinQueue a -> a -> MinQueue a) -> MinQueue a -> [a] -> MinQueue a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> MinQueue a -> MinQueue a) -> MinQueue a -> a -> MinQueue a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMinQ') MinQueue a
forall a. MinQueue a
empty [a]
xs

-- | Equivalent to 'toListU'.
elemsU :: MinQueue a -> [a]
elemsU :: MinQueue a -> [a]
elemsU = MinQueue a -> [a]
forall a. MinQueue a -> [a]
toListU

-- | Constructs a priority queue out of the keys of the specified 'Prio.MinPQueue'.
keysQueue :: Prio.MinPQueue k a -> MinQueue k
keysQueue :: MinPQueue k a -> MinQueue k
keysQueue MinPQueue k a
Prio.Empty = MinQueue k
forall a. MinQueue a
Empty
keysQueue (Prio.MinPQ Int
n k
k a
_ BinomHeap k a
ts) = Int -> k -> MinQueue k -> MinQueue k
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue Int
n k
k (BinomHeap k -> MinQueue k
forall a. BinomHeap a -> MinQueue a
BQ.MinQueue ((Zero k a -> Zero k) -> BinomHeap k a -> BinomHeap k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF (Zero k -> Zero k a -> Zero k
forall a b. a -> b -> a
const Zero k
forall a. Zero a
Zero) BinomHeap k a
ts))

keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k
keysF :: (pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF pRk k a -> rk k
f BinomForest pRk k a
ts0 = case BinomForest pRk k a
ts0 of
  BinomForest pRk k a
Prio.Nil       -> BinomForest rk k
forall (rk :: * -> *) a. BinomForest rk a
Nil
  Prio.Skip BinomForest (Succ pRk) k a
ts'  -> BinomForest (Succ rk) k -> BinomForest rk k
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip ((Succ pRk k a -> Succ rk k)
-> BinomForest (Succ pRk) k a -> BinomForest (Succ rk) k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF Succ pRk k a -> Succ rk k
f' BinomForest (Succ pRk) k a
ts')
  Prio.Cons (Prio.BinomTree k
k a
_ pRk k a
ts) BinomForest (Succ pRk) k a
ts'
    -> BinomTree rk k -> BinomForest (Succ rk) k -> BinomForest rk k
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons (k -> rk k -> BinomTree rk k
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree k
k (pRk k a -> rk k
f pRk k a
ts)) ((Succ pRk k a -> Succ rk k)
-> BinomForest (Succ pRk) k a -> BinomForest (Succ rk) k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF Succ pRk k a -> Succ rk k
f' BinomForest (Succ pRk) k a
ts')
  where  f' :: Succ pRk k a -> Succ rk k
f' (Prio.Succ (Prio.BinomTree k
k a
_ pRk k a
ts) pRk k a
tss) = BinomTree rk k -> rk k -> Succ rk k
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ (k -> rk k -> BinomTree rk k
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree k
k (pRk k a -> rk k
f pRk k a
ts)) (pRk k a -> rk k
f pRk k a
tss)