Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
A flexible implementation of min-, max-, min-priority, max-priority and custom-priority heaps based on the leftist-heaps from Chris Okasaki's book "Purely Functional Data Structures", Cambridge University Press, 1998, chapter 3.1.
There are different flavours of Heap
s, each of them following a different
strategy when ordering its elements:
- Choose
MinHeap
orMaxHeap
if you need a simple minimum or maximum heap (which always keeps the minimum/maximum element at the head of theHeap
). - If you wish to manually annotate a value with a priority, e. g. an
IO ()
action with anInt
useMinPrioHeap
orMaxPrioHeap
. They manage(prio, val)
tuples so that only the priority (and not the value) influences the order of elements. - If you still need something different, define a custom order for the heap
elements by implementing an instance of
HeapItem
and let the maintainer know what's missing.
All sorts of heaps mentioned above (MinHeap
, MaxHeap
, MinPrioHeap
and
MaxPrioHeap
) are built on the same underlying type:
. It is
a simple minimum priority heap. The trick is, that you never insert HeapT
prio val(prio,
val)
pairs directly: You only insert an "external representation", usually
called item
, and an appropriate HeapItem
instance is used to split
the
item
to a (prio, val)
pair. For details refer to the documentation of
HeapItem
.
- data HeapT prio val
- type Heap pol item = HeapT (Prio pol item) (Val pol item)
- type MinHeap a = Heap MinPolicy a
- type MaxHeap a = Heap MaxPolicy a
- type MinPrioHeap prio val = Heap FstMinPolicy (prio, val)
- type MaxPrioHeap prio val = Heap FstMaxPolicy (prio, val)
- class Ord (Prio pol item) => HeapItem pol item where
- data MinPolicy
- data MaxPolicy
- data FstMinPolicy
- data FstMaxPolicy
- isEmpty :: HeapT prio val -> Bool
- null :: HeapT prio val -> Bool
- size :: HeapT prio val -> Int
- empty :: HeapT prio val
- singleton :: HeapItem pol item => item -> Heap pol item
- insert :: HeapItem pol item => item -> Heap pol item -> Heap pol item
- union :: Ord prio => HeapT prio val -> HeapT prio val -> HeapT prio val
- unions :: Ord prio => [HeapT prio val] -> HeapT prio val
- view :: HeapItem pol item => Heap pol item -> Maybe (item, Heap pol item)
- viewHead :: HeapItem pol item => Heap pol item -> Maybe item
- viewTail :: HeapItem pol item => Heap pol item -> Maybe (Heap pol item)
- filter :: HeapItem pol item => (item -> Bool) -> Heap pol item -> Heap pol item
- partition :: HeapItem pol item => (item -> Bool) -> Heap pol item -> (Heap pol item, Heap pol item)
- take :: HeapItem pol item => Int -> Heap pol item -> [item]
- drop :: HeapItem pol item => Int -> Heap pol item -> Heap pol item
- splitAt :: HeapItem pol item => Int -> Heap pol item -> ([item], Heap pol item)
- takeWhile :: HeapItem pol item => (item -> Bool) -> Heap pol item -> [item]
- dropWhile :: HeapItem pol item => (item -> Bool) -> Heap pol item -> Heap pol item
- span :: HeapItem pol item => (item -> Bool) -> Heap pol item -> ([item], Heap pol item)
- break :: HeapItem pol item => (item -> Bool) -> Heap pol item -> ([item], Heap pol item)
- fromList :: HeapItem pol item => [item] -> Heap pol item
- toList :: HeapItem pol item => Heap pol item -> [item]
- fromAscList :: HeapItem pol item => [item] -> Heap pol item
- toAscList :: HeapItem pol item => Heap pol item -> [item]
- fromDescList :: HeapItem pol item => [item] -> Heap pol item
- toDescList :: HeapItem pol item => Heap pol item -> [item]
Types
Various heap flavours
The basic heap type. It stores priority-value pairs (prio, val)
and
always keeps the pair with minimal priority on top. The value associated to
the priority does not have any influence on the ordering of elements.
Functor (HeapT prio) | |
Ord prio => Foldable (HeapT prio) | |
(Ord prio, Ord val) => Eq (HeapT prio val) | |
(Ord prio, Ord val) => Ord (HeapT prio val) | |
(Read prio, Read val, Ord prio) => Read (HeapT prio val) | |
(Show prio, Show val) => Show (HeapT prio val) | |
Ord prio => Monoid (HeapT prio val) | |
Typeable (* -> * -> *) HeapT |
type MinPrioHeap prio val = Heap FstMinPolicy (prio, val) Source
A Heap
storing priority-value pairs (prio, val)
. The order of elements
is solely determined by the priority prio
, the value val
has no influence.
The priority-value pair with minmal priority will always be extracted first.
type MaxPrioHeap prio val = Heap FstMaxPolicy (prio, val) Source
A Heap
storing priority-value pairs (prio, val)
. The order of elements
is solely determined by the priority prio
, the value val
has no influence.
The priority-value pair with maximum priority will always be extracted first.
Ordering strategies
class Ord (Prio pol item) => HeapItem pol item where Source
is a type class for items that can be stored in a
HeapItem
pol itemHeapT
. A raw
only provides a minimum priority heap (i. e.
HeapT
prio valval
doesn't influence the ordering of elements and the pair with minimal
prio
will be extracted first, see HeapT
documentation). The job of this
class is to translate between arbitrary item
s and priority-value pairs
(
, depending on the policy Prio
pol item, Val
pol item)pol
to be used.
This way, we are able to use HeapT
not only as MinPrioHeap
, but also as
MinHeap
, MaxHeap
, MaxPrioHeap
or a custom implementation. In short: The
job of this class is to deconstruct arbitrary item
s into a (prio, val)
pairs that can be handled by a minimum priority HeapT
.
Example: Consider you want to use
as a HeapT
prio val
. You
would have to invert the order of MaxHeap
aa
(e. g. by introducing newtype InvOrd a
= InvOrd a
along with an apropriate Ord
instance for it) and then use a
type
. You'd also have to translate
every MaxHeap
a = HeapT
(InvOrd a) ()x
to (InvOrd x, ())
before insertion and back after removal in
order to retrieve your original type a
.
This functionality is provided by the HeapItem
class. In the above example,
you'd use a MaxHeap
. The according instance declaration is of course
already provided and looks like this (simplified):
@data MaxPolicy
instance (Ord
a) => HeapItem
MaxPolicy
a where
newtype Prio
MaxPolicy
a = MaxP a deriving (Eq
)
type Val
MaxPolicy
a = ()
split
x = (MaxP x, ())
merge
(MaxP x, _) = x
instance (Ord
a) => Ord
(Prio
MaxPolicy
a) where
compare
(MaxP x) (MaxP y) = compare
y x
@
MaxPolicy
is a phantom type describing which HeapItem
instance is actually
meant (e. g. we have to distinguish between MinHeap
and MaxHeap
, which is
done via MinPolicy
and MaxPolicy
, respectively) and MaxP
inverts the
ordering of a
, so that the maximum will be on top of the HeapT
.
The conversion functions split
and merge
have to make sure that
data Prio pol item :: * Source
The part of item
that determines the order of elements on a HeapT
.
Everything not part of Prio
pol item
Policy type for a MinHeap
.
Policy type for a MaxHeap
.
data FstMinPolicy Source
Policy type for a (prio, val)
MinPrioHeap
.
Ord prio => HeapItem FstMinPolicy (prio, val) | |
Eq prio => Eq (Prio FstMinPolicy (prio, val)) | |
Ord prio => Ord (Prio FstMinPolicy (prio, val)) | |
Read prio => Read (Prio FstMinPolicy (prio, val)) | |
Show prio => Show (Prio FstMinPolicy (prio, val)) | |
data Prio FstMinPolicy (prio, val) = FMinP {
| |
type Val FstMinPolicy (prio, val) = val |
data FstMaxPolicy Source
Policy type for a (prio, val)
MaxPrioHeap
.
Ord prio => HeapItem FstMaxPolicy (prio, val) | |
Eq prio => Eq (Prio FstMaxPolicy (prio, val)) | |
Ord prio => Ord (Prio FstMaxPolicy (prio, val)) | |
Read prio => Read (Prio FstMaxPolicy (prio, val)) | |
Show prio => Show (Prio FstMaxPolicy (prio, val)) | |
data Prio FstMaxPolicy (prio, val) = FMaxP {
| |
type Val FstMaxPolicy (prio, val) = val |
Query
Construction
insert :: HeapItem pol item => item -> Heap pol item -> Heap pol item Source
O(log n). Insert a single item into the HeapT
.
union :: Ord prio => HeapT prio val -> HeapT prio val -> HeapT prio val Source
O(log max(n, m)). Form the union of two HeapT
s.
Deconstruction
Filter
filter :: HeapItem pol item => (item -> Bool) -> Heap pol item -> Heap pol item Source
Remove all items from a HeapT
not fulfilling a predicate.
partition :: HeapItem pol item => (item -> Bool) -> Heap pol item -> (Heap pol item, Heap pol item) Source
Subranges
take :: HeapItem pol item => Int -> Heap pol item -> [item] Source
Take the first n
items from the Heap
.
drop :: HeapItem pol item => Int -> Heap pol item -> Heap pol item Source
Remove first n
items from the Heap
.
splitAt :: HeapItem pol item => Int -> Heap pol item -> ([item], Heap pol item) Source
: Return a list of the first splitAt
n hn
items of h
and h
, with
those elements removed.
takeWhile :: HeapItem pol item => (item -> Bool) -> Heap pol item -> [item] Source
: List the longest prefix of items in takeWhile
p hh
that satisfy p
.
dropWhile :: HeapItem pol item => (item -> Bool) -> Heap pol item -> Heap pol item Source
: Remove the longest prefix of items in dropWhile
p hh
that satisfy
p
.
span :: HeapItem pol item => (item -> Bool) -> Heap pol item -> ([item], Heap pol item) Source
: Return the longest prefix of items in span
p hh
that satisfy p
and
h
, with those elements removed.
break :: HeapItem pol item => (item -> Bool) -> Heap pol item -> ([item], Heap pol item) Source
: The longest prefix of items in break
p hh
that do not satisfy p
and h
, with those elements removed.
Conversion
List
fromList :: HeapItem pol item => [item] -> Heap pol item Source
O(n log n). Build a Heap
from the given items. Assuming you have a
sorted list, you probably want to use fromDescList
or fromAscList
, they
are faster than this function.
toList :: HeapItem pol item => Heap pol item -> [item] Source
O(n log n). List all items of the Heap
in no specific order.
Ordered list
fromAscList :: HeapItem pol item => [item] -> Heap pol item Source
O(n). Create a Heap
from a list providing its items in ascending order
of priority (i. e. in the same order they will be removed from the Heap
).
This function is faster than fromList
but not as fast as fromDescList
.
The precondition is not checked.
toAscList :: HeapItem pol item => Heap pol item -> [item] Source
O(n log n). List the items of the Heap
in ascending order of priority.
fromDescList :: HeapItem pol item => [item] -> Heap pol item Source
O(n). Create a Heap
from a list providing its items in descending order
of priority (i. e. they will be removed inversely from the Heap
). Prefer
this function over fromList
and fromAscList
, it's faster.
The precondition is not checked.
toDescList :: HeapItem pol item => Heap pol item -> [item] Source
O(n log n). List the items of the Heap
in descending order of priority.
Note that this function is not especially efficient (it is implemented in
terms of reverse
and toAscList
), it is provided as a counterpart of the
efficient fromDescList
function.