Copyright | (c) NoviSci Inc 2020 |
---|---|
License | BSD3 |
Maintainer | bsaul@novisci.com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
In the examples below, iv
is a synonym for beginerval
used to save space.
Synopsis
- relations :: (IntervalAlgebraic i a, Foldable f) => f (i a) -> [IntervalRelation (i a)]
- relations' :: (IntervalAlgebraic i a, Foldable f, Applicative m, Monoid (m (IntervalRelation (i a)))) => f (i a) -> m (IntervalRelation (i a))
- intersect :: (IntervalSizeable a b, IntervalAlgebraic i a) => i a -> i a -> Maybe (Interval a)
- combineIntervals :: (IntervalAlgebraic Interval a, Applicative f, Monoid (f (Interval a)), Foldable f) => f (Interval a) -> f (Interval a)
- combineIntervals' :: IntervalAlgebraic Interval a => [Interval a] -> [Interval a]
- gaps :: (IntervalCombinable Interval a, Applicative f, Monoid (f (Interval a)), Foldable f) => f (Interval a) -> f (Interval a)
- gaps' :: (IntervalCombinable Interval a, Applicative f, Monoid (f (Interval a)), Foldable f) => f (Interval a) -> [Interval a]
- durations :: (Functor f, Intervallic i a, IntervalSizeable a b) => f (i a) -> f b
- clip :: (IntervalAlgebraic Interval a, IntervalSizeable a b) => Interval a -> Interval a -> Maybe (Interval a)
- gapsWithin :: (Applicative f, Foldable f, Monoid (f (Interval a)), IntervalSizeable a b, IntervalCombinable Interval a, Filterable f, IntervalAlgebraic Interval a) => Interval a -> f (Interval a) -> Maybe (f (Interval a))
- nothingIf :: (Monoid (f (i a)), Filterable f, IntervalAlgebraic i a) => ((i a -> Bool) -> f (i a) -> Bool) -> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
- nothingIfNone :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a) => (i a -> Bool) -> f (i a) -> Maybe (f (i a))
- nothingIfAny :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a) => (i a -> Bool) -> f (i a) -> Maybe (f (i a))
- nothingIfAll :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a) => (i a -> Bool) -> f (i a) -> Maybe (f (i a))
- foldMeetingSafe :: (IntervalAlgebraic (PairedInterval b) a, Eq b) => [PairedInterval b a] -> [PairedInterval b a]
- formMeetingSequence :: (Eq b, Monoid b, IntervalSizeable a c) => [PairedInterval b a] -> [PairedInterval b a]
- compareIntervals :: (IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => ComparativePredicateOf (Interval a) -> i0 a -> i1 a -> Bool
- filterBefore :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterMeets :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterOverlaps :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterFinishedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterContains :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterStarts :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterEquals :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterStartedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterDuring :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterFinishes :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterOverlappedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterMetBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterAfter :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterDisjoint :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterNotDisjoint :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterConcur :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterWithin :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterEnclose :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
- filterEnclosedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a)
Documentation
relations :: (IntervalAlgebraic i a, Foldable f) => f (i a) -> [IntervalRelation (i a)] Source #
Returns a list of the IntervalRelation
between each consecutive pair
of intervals. This the specialized form of relations'
which can return
any Applicative
, Monoid
structure.
>>>
relations [iv 1 0, iv 1 1]
[Meets]
relations' :: (IntervalAlgebraic i a, Foldable f, Applicative m, Monoid (m (IntervalRelation (i a)))) => f (i a) -> m (IntervalRelation (i a)) Source #
A generic form of relations
which can output any Applicative
and
Monoid
structure.
>>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)]
[Meets]
intersect :: (IntervalSizeable a b, IntervalAlgebraic i a) => i a -> i a -> Maybe (Interval a) Source #
Forms a Just
new interval from the intersection of two intervals,
provided the intervals are not disjoint.
combineIntervals :: (IntervalAlgebraic Interval a, Applicative f, Monoid (f (Interval a)), Foldable f) => f (Interval a) -> f (Interval a) Source #
Returns a container of intervals where any intervals that meet or share support
are combined into one interval. *To work properly, the input should
be sorted*. See combineIntervals'
for a version that works only on lists.
>>>
combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
[(0, 12),(13, 15)]
combineIntervals' :: IntervalAlgebraic Interval a => [Interval a] -> [Interval a] Source #
Returns a list of intervals where any intervals that meet or share support are combined into one interval. *To work properly, the input list should be sorted*.
>>>
combineIntervals' [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
[(0, 12),(13, 15)]
gaps :: (IntervalCombinable Interval a, Applicative f, Monoid (f (Interval a)), Foldable f) => f (Interval a) -> f (Interval a) Source #
Returns a (possibly empty) container of intervals consisting of the gaps
between intervals in the input. *To work properly, the input should be
sorted*. See gaps'
for a version that returns a list.
>>>
gaps [iv 4 1, iv 4 8, iv 3 11]
[(5, 8)]
gaps' :: (IntervalCombinable Interval a, Applicative f, Monoid (f (Interval a)), Foldable f) => f (Interval a) -> [Interval a] Source #
Returns a (possibly empty) list of intervals consisting of the gaps between
intervals in the input container. *To work properly, the input should be
sorted*. This version outputs a list. See gaps
for a version that lifts
the result to same input structure f
.
durations :: (Functor f, Intervallic i a, IntervalSizeable a b) => f (i a) -> f b Source #
clip :: (IntervalAlgebraic Interval a, IntervalSizeable a b) => Interval a -> Interval a -> Maybe (Interval a) Source #
In the case that x y are not disjoint, clips y to the extent of x.
>>>
clip (iv 5 0) (iv 3 3)
Just (3, 5)
>>>
clip (iv 3 0) (iv 2 4)
Nothing
:: (Applicative f, Foldable f, Monoid (f (Interval a)), IntervalSizeable a b, IntervalCombinable Interval a, Filterable f, IntervalAlgebraic Interval a) | |
=> Interval a | i |
-> f (Interval a) | x |
-> Maybe (f (Interval a)) |
Applies gaps
to all the non-disjoint intervals in x
that are *not* disjoint
from i
. Intervals that overlaps
or are overlappedBy
i
are clip
ped
to i
, so that all the intervals are within
i
. If there are no gaps, then
Nothing
is returned.
>>>
gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12]
Just [(5, 7),(9, 10)]
:: (Monoid (f (i a)), Filterable f, IntervalAlgebraic i a) | |
=> ((i a -> Bool) -> f (i a) -> Bool) | |
-> (i a -> Bool) | predicate to apply to each element of input list |
-> f (i a) | |
-> Maybe (f (i a)) |
Given a predicate combinator, a predicate, and list of intervals, returns
the input unchanged if the predicate combinator is True
. Otherwise, returns
an empty list. See nothingIfAny
and nothingIfNone
for examples.
:: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a) | |
=> (i a -> Bool) | predicate to apply to each element of input list |
-> f (i a) | |
-> Maybe (f (i a)) |
Returns the Nothing
if *none* of the element of input satisfy
the predicate condition.
For example, the following returns Nothing
because none of the intervals
in the input list starts
(3, 5).
>>>
nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5]
Nothing
In the following, (3, 5) starts
(3, 6), so Just
the input is returned.
>>>
nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5]
Just [(3, 6),(5, 6)]
:: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a) | |
=> (i a -> Bool) | predicate to apply to each element of input list |
-> f (i a) | |
-> Maybe (f (i a)) |
Returns Nothing
if *any* of the element of input satisfy the predicate condition.
:: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a) | |
=> (i a -> Bool) | predicate to apply to each element of input list |
-> f (i a) | |
-> Maybe (f (i a)) |
Returns Nothing
if *all* of the element of input satisfy the predicate condition
Operations on Meeting sequences of intervals
:: (IntervalAlgebraic (PairedInterval b) a, Eq b) | |
=> [PairedInterval b a] | Be sure this only contains intervals
that sequentially |
-> [PairedInterval b a] |
Folds over a list of Paired Intervals and in the case that the getPairData
is equal between two sequential meeting intervals, these two intervals are
combined into one. This function is "safe" in the sense that if the input is
invalid and contains any sequential pairs of intervals with an IntervalRelation
,
other than Meets
, then the function returns an empty list.
formMeetingSequence :: (Eq b, Monoid b, IntervalSizeable a c) => [PairedInterval b a] -> [PairedInterval b a] Source #
Convert an ordered sequence of PairedInterval b a
. that may have any interval relation
(before
, starts
, etc) into a sequence of sequentially meeting PairedInterval b a
.
That is, a sequence where one the end of one interval meets the beginning of
the subsequent event. The getPairData
of the input PairedIntervals
are
combined using the Monoid <>
function, hence the pair data must be a
Monoid
instance.
Filtering functions
compareIntervals :: (IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => ComparativePredicateOf (Interval a) -> i0 a -> i1 a -> Bool Source #
Filter functions provides means for filtering Filterable
containers of
'Intervallic i a'
s based on
relations.IntervalAlgebraic
Lifts a predicate to be able to compare two different IntervalAlgebraic
structure by comparing the intervals contain within each.
filterBefore :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by before
.
filterMeets :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by meets
.
filterOverlaps :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by overlaps
.
filterFinishedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter byfinishedBy
.
filterContains :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by contains
.
filterStarts :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by starts
.
filterEquals :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by equals
.
filterStartedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by startedBy
.
filterDuring :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by during
.
filterFinishes :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by finishes
.
filterOverlappedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by overlappedBy
.
filterMetBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by metBy
.
filterAfter :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by after
.
filterDisjoint :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by disjoint
.
filterNotDisjoint :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by notDisjoint
.
filterConcur :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by concur
.
filterWithin :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by within
.
filterEnclose :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by enclose
.
filterEnclosedBy :: (Filterable f, IntervalAlgebraic Interval a, IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) => i0 a -> f (i1 a) -> f (i1 a) Source #
Filter by enclosedBy
.