Portability | portable |
---|---|
Stability | experimental |
Maintainer | ekmett@gmail.com |
An efficient, asymptotically optimal, implementation of a priority queues
extended with support for efficient size, and Data.Foldable
Note: Since many function names (but not the type name) clash with
Prelude names, this module is usually imported qualified
, e.g.
import Data.Heap (Heap) import qualified Data.Heap as Heap
The implementation of Heap
is based on bootstrapped skew binomial heaps
as described by:
- G. Brodal and C. Okasaki , "Optimal Purely Functional Priority Queues", Journal of Functional Programming 6:839-857 (1996), http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.48.973
All time bounds are worst-case.
- data Heap a
- data Entry p a = Entry {}
- empty :: Heap a
- null :: Heap a -> Bool
- size :: Heap a -> Int
- singleton :: Ord a => a -> Heap a
- insert :: Ord a => a -> Heap a -> Heap a
- minimum :: Heap a -> a
- deleteMin :: Heap a -> Heap a
- union :: Heap a -> Heap a -> Heap a
- uncons :: Ord a => Heap a -> Maybe (a, Heap a)
- viewMin :: Ord a => Heap a -> Maybe (a, Heap a)
- mapMonotonic :: Ord b => (a -> b) -> Heap a -> Heap b
- map :: Ord b => (a -> b) -> Heap a -> Heap b
- toUnsortedList :: Heap a -> [a]
- fromList :: Ord a => [a] -> Heap a
- sort :: Ord a => [a] -> [a]
- traverse :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b)
- mapM :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b)
- concatMap :: Ord b => (a -> Heap b) -> Heap a -> Heap b
- filter :: (a -> Bool) -> Heap a -> Heap a
- partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
- split :: a -> Heap a -> (Heap a, Heap a, Heap a)
- break :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
- span :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
- take :: Int -> Heap a -> Heap a
- drop :: Int -> Heap a -> Heap a
- splitAt :: Int -> Heap a -> (Heap a, Heap a)
- takeWhile :: (a -> Bool) -> Heap a -> Heap a
- dropWhile :: (a -> Bool) -> Heap a -> Heap a
- group :: Heap a -> Heap (Heap a)
- groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)
- nub :: Heap a -> Heap a
- intersect :: Heap a -> Heap a -> Heap a
- intersectWith :: Ord b => (a -> a -> b) -> Heap a -> Heap a -> Heap b
- replicate :: Ord a => a -> Int -> Heap a
Heap Type
A min-heap of values a
.
Entry type
Basic functions
O(1). Is the heap empty?
Data.Heap.null empty == True Data.Heap.null (singleton 1) == False
O(1). The number of elements in the heap.
size empty == 0 size (singleton 1) == 1 size (fromList [4,1,2]) == 3
singleton :: Ord a => a -> Heap aSource
O(1). A heap with a single element
singleton 1 == fromList [1] singleton 1 == insert 1 empty size (singleton 1) == 1
insert :: Ord a => a -> Heap a -> Heap aSource
O(1). Insert a new value into the heap.
insert 2 (fromList [1,3]) == fromList [3,2,1] insert 5 empty == singleton 5 size (insert "Item" xs) == 1 + size xs
O(1). Assumes the argument is a non-null
heap.
minimum (fromList [3,1,2]) == 1
deleteMin :: Heap a -> Heap aSource
O(log n). Delete the minimum key from the heap and return the resulting heap.
deleteMin (fromList [3,1,2]) == fromList [2,3]
union :: Heap a -> Heap a -> Heap aSource
O(1). Meld the values from two heaps into one heap.
union (fromList [1,3,5]) (fromList [6,4,2]) = fromList [1..6] union (fromList [1,1,1]) (fromList [1,2,1]) = fromList [1,1,1,1,1,2]
uncons :: Ord a => Heap a -> Maybe (a, Heap a)Source
O(1) access to the minimum element.
O(log n) access to the remainder of the heap
same operation as viewMin
uncons (fromList [2,1,3]) == Just (1, fromList [3,2])
Transformations
mapMonotonic :: Ord b => (a -> b) -> Heap a -> Heap bSource
O(n). Map a monotone increasing function over the heap.
Provides a better constant factor for performance than map
, but no checking is performed that the function provided is monotone increasing. Misuse of this function can cause a Heap to violate the heap property.
map (+1) (fromList [1,2,3]) = fromList [2,3,4] map (*2) (fromList [1,2,3]) = fromList [2,4,6]
map :: Ord b => (a -> b) -> Heap a -> Heap bSource
O(n). Map a function over the heap, returning a new heap ordered appropriately for its fresh contents
map negate (fromList [3,1,2]) == fromList [-2,-3,-1]
To/From Lists
toUnsortedList :: Heap a -> [a]Source
O(n). Returns the elements in the heap in some arbitrary, very likely unsorted, order.
toUnsortedList (fromList [3,1,2]) == [1,3,2] fromList . toUnsortedList == id
fromList :: Ord a => [a] -> Heap aSource
O(n). Build a heap from a list of values.
size (fromList [1,5,3]) == 3 fromList . toList = id toList . fromList = sort
traverse :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b)Source
O(n log n). Traverse the elements of the heap in sorted order and produce a new heap using Applicative
side-effects.
mapM :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b)Source
O(n log n). Traverse the elements of the heap in sorted order and produce a new heap using Monad
ic side-effects.
concatMap :: Ord b => (a -> Heap b) -> Heap a -> Heap bSource
O(n). Construct heaps from each element in another heap, and union them together.
concatMap (a -> fromList [a,a+1]) (fromList [1,4]) == fromList [1,2,4,5]
Filtering
filter :: (a -> Bool) -> Heap a -> Heap aSource
O(n). Filter the heap, retaining only values that satisfy the predicate.
filter (>'a') (fromList "ab") == singleton 'b' filter (>'x') (fromList "ab") == empty filter (<'a') (fromList "ab") == empty
partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)Source
O(n). Partition the heap according to a predicate. The first heap contains all elements that satisfy the predicate, the second all elements that fail the predicate. See also split
.
partition (>'a') (fromList "ab") (singleton 'b', singleton 'a')
split :: a -> Heap a -> (Heap a, Heap a, Heap a)Source
O(n). Partition the heap into heaps of the elements that are less than, equal to, and greater than a given value.
split 'h' (fromList "hello") == (singleton 'e', singleton 'h', fromList "lol")
break :: (a -> Bool) -> Heap a -> (Heap a, Heap a)Source
O(n log n). break
applied to a predicate p
and a heap xs
returns a tuple where the first element is a heap consisting of the
longest prefix the least elements of xs
that do not satisfy p and the second element is the remainder of the elements in the heap.
break (\x -> x `mod` 4 == 0) (fromList [3,5,7,12,13,16]) == (fromList [3,5,7], fromList [12,13,16])
span :: (a -> Bool) -> Heap a -> (Heap a, Heap a)Source
O(n log n). span
applied to a predicate p
and a heap xs
returns a tuple where the first element is a heap consisting of the
longest prefix the least elements of xs that satisfy p
and the second element is the remainder of the elements in the heap.
span (\x -> x `mod` 4 == 0) (fromList [4,8,12,14,16]) == (fromList [4,8,12],fromList [14,16])
span
p xs
is equivalent to (
takeWhile
p xs, 'dropWhile p xs)
take :: Int -> Heap a -> Heap aSource
O(n log n). Return a heap consisting of the least n
elements of a given heap.
take 3 (fromList [10,2,4,1,9,8,2]) == fromList [1,2,2]
drop :: Int -> Heap a -> Heap aSource
O(n log n). Return a heap consisting of all members of given heap except for the n
least elements.
splitAt :: Int -> Heap a -> (Heap a, Heap a)Source
O(n log n). Split a heap into two heaps, the first containing the n
least elements, the latter consisting of all members of the heap except for those elements.
takeWhile :: (a -> Bool) -> Heap a -> Heap aSource
O(n log n). takeWhile
applied to a predicate p
and a heap xs
returns a heap consisting of the
longest prefix the least elements of xs
that satisfy p
.
takeWhile (\x -> x `mod` 4 == 0) (fromList [4,8,12,14,16]) == fromList [4,8,12]
Grouping
group :: Heap a -> Heap (Heap a)Source
O(n log n). Group a heap into a heap of heaps, by unioning together duplicates.
group (fromList "hello") == fromList [fromList "h", fromList "e", fromList "ll", fromList "o"]
groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)Source
O(n log n). Group using a user supplied function.
O(n log n). Remove duplicate entries from the heap.
nub (fromList [1,1,2,6,6]) == fromList [1,2,6]
Intersection
intersect :: Heap a -> Heap a -> Heap aSource
O(n log n + m log m). Intersect the values in two heaps, returning the value in the left heap that compares as equal
intersectWith :: Ord b => (a -> a -> b) -> Heap a -> Heap a -> Heap bSource
O(n log n + m log m). Intersect the values in two heaps using a function to generate the elements in the right heap.