Copyright | (c) Christoph Breitkopf 2015 - 2017 |
---|---|
License | BSD-style |
Maintainer | chbreitkopf@gmail.com |
Stability | experimental |
Portability | non-portable (MPTC with FD) |
Safe Haskell | Safe |
Language | Haskell98 |
An implementation of sets of intervals. The intervals may overlap, and the implementation contains efficient search functions for all intervals containing a point or overlapping a given interval. Closed, open, and half-open intervals can be contained in the same set.
It is an error to insert an empty interval into a set. This precondition is not checked by the various construction functions.
Since many function names (but not the type name) clash with
Prelude names, this module is usually imported qualified
, e.g.
import Data.IntervalSet.Strict (IntervalSet) import qualified Data.IntervalSet.Strict as IS
It offers most of the same functions as Set
, but the member type must be an
instance of Interval
. The findMin
and findMax
functions deviate from their
set counterparts in being total and returning a Maybe
value.
Some functions differ in asymptotic performance (for example size
) or have not
been tuned for efficiency as much as their equivalents in Set
.
In addition, there are functions specific to sets of intervals, for example to search for all intervals containing a given point or contained in a given interval.
The implementation is a red-black tree augmented with the maximum upper bound of all keys.
Parts of this implementation are based on code from the Map
implementation,
(c) Daan Leijen 2002, (c) Andriy Palamarchuk 2008.
The red-black tree deletion is based on code from llrbtree by Kazu Yamamoto.
Of course, any errors are mine.
Synopsis
- class Ord e => Interval i e | i -> e where
- lowerBound :: i -> e
- upperBound :: i -> e
- leftClosed :: i -> Bool
- rightClosed :: i -> Bool
- before :: i -> i -> Bool
- after :: i -> i -> Bool
- subsumes :: i -> i -> Bool
- overlaps :: i -> i -> Bool
- below :: e -> i -> Bool
- above :: e -> i -> Bool
- inside :: e -> i -> Bool
- isEmpty :: i -> Bool
- compareUpperBounds :: i -> i -> Ordering
- data IntervalSet k
- = Nil
- | Node !Color !k !k !(IntervalSet k) !(IntervalSet k)
- (\\) :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
- null :: IntervalSet k -> Bool
- size :: IntervalSet k -> Int
- member :: Ord k => k -> IntervalSet k -> Bool
- notMember :: Ord k => k -> IntervalSet k -> Bool
- lookupLT :: Ord k => k -> IntervalSet k -> Maybe k
- lookupGT :: Ord k => k -> IntervalSet k -> Maybe k
- lookupLE :: Ord k => k -> IntervalSet k -> Maybe k
- lookupGE :: Ord k => k -> IntervalSet k -> Maybe k
- containing :: Interval k e => IntervalSet k -> e -> IntervalSet k
- intersecting :: Interval k e => IntervalSet k -> k -> IntervalSet k
- within :: Interval k e => IntervalSet k -> k -> IntervalSet k
- empty :: IntervalSet k
- singleton :: k -> IntervalSet k
- insert :: (Interval k e, Ord k) => k -> IntervalSet k -> IntervalSet k
- delete :: (Interval k e, Ord k) => k -> IntervalSet k -> IntervalSet k
- union :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
- unions :: (Interval k e, Ord k) => [IntervalSet k] -> IntervalSet k
- difference :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
- intersection :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k
- map :: (Interval b e2, Ord b) => (a -> b) -> IntervalSet a -> IntervalSet b
- mapMonotonic :: (Interval k2 e, Ord k2) => (k1 -> k2) -> IntervalSet k1 -> IntervalSet k2
- foldr :: (k -> b -> b) -> b -> IntervalSet k -> b
- foldl :: (b -> k -> b) -> b -> IntervalSet k -> b
- foldl' :: (b -> k -> b) -> b -> IntervalSet k -> b
- foldr' :: (k -> b -> b) -> b -> IntervalSet k -> b
- flattenWith :: (Ord a, Interval a e) => (a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a
- flattenWithMonotonic :: Interval a e => (a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a
- elems :: IntervalSet k -> [k]
- toList :: IntervalSet k -> [k]
- fromList :: (Interval k e, Ord k) => [k] -> IntervalSet k
- toAscList :: IntervalSet k -> [k]
- toDescList :: IntervalSet k -> [k]
- fromAscList :: (Interval k e, Eq k) => [k] -> IntervalSet k
- fromDistinctAscList :: Interval k e => [k] -> IntervalSet k
- filter :: Interval k e => (k -> Bool) -> IntervalSet k -> IntervalSet k
- partition :: Interval k e => (k -> Bool) -> IntervalSet k -> (IntervalSet k, IntervalSet k)
- split :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, IntervalSet i)
- splitMember :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i)
- splitAt :: Interval i k => IntervalSet i -> k -> (IntervalSet i, IntervalSet i, IntervalSet i)
- splitIntersecting :: (Interval i k, Ord i) => IntervalSet i -> i -> (IntervalSet i, IntervalSet i, IntervalSet i)
- isSubsetOf :: Ord k => IntervalSet k -> IntervalSet k -> Bool
- isProperSubsetOf :: Ord k => IntervalSet k -> IntervalSet k -> Bool
- findMin :: IntervalSet k -> Maybe k
- findMax :: IntervalSet k -> Maybe k
- findLast :: Interval k e => IntervalSet k -> Maybe k
- deleteMin :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
- deleteMax :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k
- deleteFindMin :: (Interval k e, Ord k) => IntervalSet k -> (k, IntervalSet k)
- deleteFindMax :: (Interval k e, Ord k) => IntervalSet k -> (k, IntervalSet k)
- minView :: (Interval k e, Ord k) => IntervalSet k -> Maybe (k, IntervalSet k)
- maxView :: (Interval k e, Ord k) => IntervalSet k -> Maybe (k, IntervalSet k)
- valid :: (Interval i k, Ord i) => IntervalSet i -> Bool
re-export
class Ord e => Interval i e | i -> e where Source #
Intervals with endpoints of type e
.
A minimal instance declaration for a closed interval needs only
to define lowerBound
and upperBound
.
lowerBound :: i -> e Source #
lower bound
upperBound :: i -> e Source #
upper bound
leftClosed :: i -> Bool Source #
Does the interval include its lower bound? Default is True for all values, i.e. closed intervals.
rightClosed :: i -> Bool Source #
Does the interval include its upper bound bound? Default is True for all values, i.e. closed intervals.
before :: i -> i -> Bool Source #
Interval strictly before another? True if the upper bound of the first interval is below the lower bound of the second.
after :: i -> i -> Bool Source #
Interval strictly after another? Same as 'flip before'.
subsumes :: i -> i -> Bool Source #
Does the first interval completely contain the second?
overlaps :: i -> i -> Bool Source #
Do the two intervals overlap?
below :: e -> i -> Bool Source #
Is a point strictly less than lower bound?
above :: e -> i -> Bool Source #
Is a point strictly greater than upper bound?
inside :: e -> i -> Bool Source #
Does the interval contain a given point?
Is the interval empty?
compareUpperBounds :: i -> i -> Ordering Source #
Instances
Ord a => Interval (Interval a) a Source # | |
Defined in Data.IntervalMap.Generic.Interval lowerBound :: Interval a -> a Source # upperBound :: Interval a -> a Source # leftClosed :: Interval a -> Bool Source # rightClosed :: Interval a -> Bool Source # before :: Interval a -> Interval a -> Bool Source # after :: Interval a -> Interval a -> Bool Source # subsumes :: Interval a -> Interval a -> Bool Source # overlaps :: Interval a -> Interval a -> Bool Source # below :: a -> Interval a -> Bool Source # above :: a -> Interval a -> Bool Source # inside :: a -> Interval a -> Bool Source # isEmpty :: Interval a -> Bool Source # compareUpperBounds :: Interval a -> Interval a -> Ordering Source # |
Set type
data IntervalSet k Source #
A set of intervals of type k
.
Nil | |
Node !Color !k !k !(IntervalSet k) !(IntervalSet k) |
Instances
Operators
(\\) :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k infixl 9 Source #
Same as difference
.
Query
null :: IntervalSet k -> Bool Source #
O(1). Is the set empty?
size :: IntervalSet k -> Int Source #
O(n). Number of keys in the set.
Caution: unlike size
, this takes linear time!
member :: Ord k => k -> IntervalSet k -> Bool Source #
O(log n). Does the set contain the given value? See also notMember
.
notMember :: Ord k => k -> IntervalSet k -> Bool Source #
O(log n). Does the set not contain the given value? See also member
.
lookupLT :: Ord k => k -> IntervalSet k -> Maybe k Source #
O(log n). Find the largest key smaller than the given one.
lookupGT :: Ord k => k -> IntervalSet k -> Maybe k Source #
O(log n). Find the smallest key larger than the given one.
lookupLE :: Ord k => k -> IntervalSet k -> Maybe k Source #
O(log n). Find the largest key equal to or smaller than the given one.
lookupGE :: Ord k => k -> IntervalSet k -> Maybe k Source #
O(log n). Find the smallest key equal to or larger than the given one.
Interval query
containing :: Interval k e => IntervalSet k -> e -> IntervalSet k Source #
Return the set of all intervals containing the given point.
This is the second element of the value of splitAt
:
set `containing` p == let (_,s,_) = set `splitAt` p in s
O(n), since potentially all intervals could contain the point. O(log n) average case. This is also the worst case for sets containing no overlapping intervals.
intersecting :: Interval k e => IntervalSet k -> k -> IntervalSet k Source #
Return the set of all intervals overlapping (intersecting) the given interval.
This is the second element of the result of splitIntersecting
:
set `intersecting` i == let (_,s,_) = set `splitIntersecting` i in s
O(n), since potentially all values could intersect the interval. O(log n) average case, if few values intersect the interval.
within :: Interval k e => IntervalSet k -> k -> IntervalSet k Source #
Return the set of all intervals which are completely inside the given interval.
O(n), since potentially all values could be inside the interval. O(log n) average case, if few keys are inside the interval.
Construction
empty :: IntervalSet k Source #
O(1). The empty set.
singleton :: k -> IntervalSet k Source #
O(1). A set with one entry.
Insertion
insert :: (Interval k e, Ord k) => k -> IntervalSet k -> IntervalSet k Source #
O(log n). Insert a new value. If the set already contains an element equal to the value, it is replaced by the new value.
Delete/Update
delete :: (Interval k e, Ord k) => k -> IntervalSet k -> IntervalSet k Source #
O(log n). Delete an element from the set. If the set does not contain the value, it is returned unchanged.
Combine
union :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k Source #
O(n+m). The expression (
) takes the left-biased union of union
t1 t2t1
and t2
.
It prefers t1
when duplicate elements are encountered.
unions :: (Interval k e, Ord k) => [IntervalSet k] -> IntervalSet k Source #
difference :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k Source #
O(n+m). Difference of two sets. Return elements of the first set not existing in the second set.
intersection :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k -> IntervalSet k Source #
O(n+m). Intersection of two sets. Return elements in the first set also existing in the second set.
Traversal
Map
map :: (Interval b e2, Ord b) => (a -> b) -> IntervalSet a -> IntervalSet b Source #
O(n log n). Map a function over all values in the set.
The size of the result may be smaller if f
maps two or more distinct
elements to the same value.
mapMonotonic :: (Interval k2 e, Ord k2) => (k1 -> k2) -> IntervalSet k1 -> IntervalSet k2 Source #
O(n).
, but works only when mapMonotonic
f s == map
f sf
is strictly monotonic.
That is, for any values x
and y
, if x
< y
then f x
< f y
.
The precondition is not checked.
Fold
foldr :: (k -> b -> b) -> b -> IntervalSet k -> b Source #
foldl :: (b -> k -> b) -> b -> IntervalSet k -> b Source #
foldl' :: (b -> k -> b) -> b -> IntervalSet k -> b Source #
O(n). A strict version of foldl
. Each application of the operator is
evaluated before using the result in the next application. This
function is strict in the starting value.
foldr' :: (k -> b -> b) -> b -> IntervalSet k -> b Source #
O(n). A strict version of foldr
. Each application of the operator is
evaluated before using the result in the next application. This
function is strict in the starting value.
Flatten
flattenWith :: (Ord a, Interval a e) => (a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a Source #
O(n log n). Build a new set by combining successive values.
flattenWithMonotonic :: Interval a e => (a -> a -> Maybe a) -> IntervalSet a -> IntervalSet a Source #
O(n). Build a new set by combining successive values.
Same as flattenWith
, but works only when the combining functions returns
strictly monotonic values.
Conversion
elems :: IntervalSet k -> [k] Source #
O(n). List of all values in the set, in ascending order.
Lists
toList :: IntervalSet k -> [k] Source #
O(n). The list of all values in the set, in no particular order.
fromList :: (Interval k e, Ord k) => [k] -> IntervalSet k Source #
O(n log n). Build a set from a list of elements. See also fromAscList
.
If the list contains duplicate values, the last value is retained.
Ordered lists
toAscList :: IntervalSet k -> [k] Source #
O(n). The list of all values contained in the set, in ascending order.
toDescList :: IntervalSet k -> [k] Source #
O(n). The list of all values in the set, in descending order.
fromAscList :: (Interval k e, Eq k) => [k] -> IntervalSet k Source #
O(n). Build a set from an ascending list in linear time. The precondition (input list is ascending) is not checked.
fromDistinctAscList :: Interval k e => [k] -> IntervalSet k Source #
O(n). Build a set from an ascending list of distinct elements in linear time. The precondition is not checked.
Filter
filter :: Interval k e => (k -> Bool) -> IntervalSet k -> IntervalSet k Source #
O(n). Filter values satisfying a predicate.
partition :: Interval k e => (k -> Bool) -> IntervalSet k -> (IntervalSet k, IntervalSet k) Source #
O(n). Partition the set according to a predicate. The first
set contains all elements that satisfy the predicate, the second all
elements that fail the predicate. See also split
.
split :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, IntervalSet i) Source #
O(n). The expression (
) is a pair split
k set(set1,set2)
where
the elements in set1
are smaller than k
and the elements in set2
larger than k
.
Any key equal to k
is found in neither set1
nor set2
.
splitMember :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i) Source #
O(n). The expression (
) splits a set just
like splitMember
k setsplit
but also returns
.member
k set
splitAt :: Interval i k => IntervalSet i -> k -> (IntervalSet i, IntervalSet i, IntervalSet i) Source #
O(n). Split around a point. Splits the set into three subsets: intervals below the point, intervals containing the point, and intervals above the point.
splitIntersecting :: (Interval i k, Ord i) => IntervalSet i -> i -> (IntervalSet i, IntervalSet i, IntervalSet i) Source #
O(n). Split around an interval. Splits the set into three subsets: intervals below the given interval, intervals intersecting the given interval, and intervals above the given interval.
Subset
isSubsetOf :: Ord k => IntervalSet k -> IntervalSet k -> Bool Source #
O(n+m). Is the first set a subset of the second set? This is always true for equal sets.
isProperSubsetOf :: Ord k => IntervalSet k -> IntervalSet k -> Bool Source #
O(n+m). Is the first set a proper subset of the second set? (i.e. a subset but not equal).
Min/Max
findMin :: IntervalSet k -> Maybe k Source #
O(log n). Returns the minimal value in the set.
findMax :: IntervalSet k -> Maybe k Source #
O(log n). Returns the maximal value in the set.
findLast :: Interval k e => IntervalSet k -> Maybe k Source #
Returns the interval with the largest endpoint. If there is more than one interval with that endpoint, return the rightmost.
O(n), since all intervals could have the same endpoint. O(log n) average case.
deleteMin :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k Source #
O(log n). Remove the smallest element from the set. Return the empty set if the set is empty.
deleteMax :: (Interval k e, Ord k) => IntervalSet k -> IntervalSet k Source #
O(log n). Remove the largest element from the set. Return the empty set if the set is empty.
deleteFindMin :: (Interval k e, Ord k) => IntervalSet k -> (k, IntervalSet k) Source #
O(log n). Delete and return the smallest element.
deleteFindMax :: (Interval k e, Ord k) => IntervalSet k -> (k, IntervalSet k) Source #
O(log n). Delete and return the largest element.
minView :: (Interval k e, Ord k) => IntervalSet k -> Maybe (k, IntervalSet k) Source #
O(log n). Retrieves the minimal element of the set, and
the set stripped of that element, or Nothing
if passed an empty set.
maxView :: (Interval k e, Ord k) => IntervalSet k -> Maybe (k, IntervalSet k) Source #
O(log n). Retrieves the maximal element of the set, and
the set stripped of that element, or Nothing
if passed an empty set.