| Portability | portable |
|---|---|
| Stability | experimental |
| Maintainer | ekmett@gmail.com |
Data.Heap
Contents
Description
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 Monadic 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.