Copyright | (c) NoviSci Inc 2020 |
---|---|
License | BSD3 |
Maintainer | bsaul@novisci.com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
The IntervalAlgebra
module provides data types and related classes for the
interval-based temporal logic described in Allen (1983)
and axiomatized in Allen and Hayes (1987).
A good primer on Allen's algebra can be found here.
Design
The module is built around four typeclasses designed to separate concerns of
constructing, relating, and combining
s: Interval
provides an interface to the data structure of anIntervallic
, defining how anInterval
is constructed.Interval
a
provides an interface to theIntervalAlgebraic
, the workhorse of Allen's temporal logic.IntervalRelation
s
provides an interface to methods of combining twoIntervalCombinable
.Interval
s
and the relatedIntervalSizeable
provides methods for measuring and modifying the size of an interval. collections of intervals.Moment
An advantage of nested typeclass design is that developers can define an
of type Interval
a
with just the amount of structure that they need.
Total Ordering of Interval
s
The modules makes the (opinionated) choice of a total ordering for Intervallic
s. Namely, the ordering is based on first ordering the Interval
begin
s
then the end
s.
Development
This module is under development and the API may change in the future.
Synopsis
- class (Ord a, Show a) => Intervallic a where
- parseInterval :: a -> a -> Either String (Interval a)
- unsafeInterval :: a -> a -> Interval a
- begin, end :: Interval a -> a
- class (Eq a, Intervallic a) => IntervalAlgebraic a where
- relate :: Interval a -> Interval a -> IntervalRelation a
- predicate' :: IntervalRelation a -> ComparativePredicateOf (Interval a)
- predicates :: Set (IntervalRelation a) -> [ComparativePredicateOf (Interval a)]
- predicate :: Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
- toSet :: [IntervalRelation a] -> Set (IntervalRelation a)
- compose :: IntervalRelation a -> IntervalRelation a -> Set (IntervalRelation a)
- complement :: Set (IntervalRelation a) -> Set (IntervalRelation a)
- intersection :: Set (IntervalRelation a) -> Set (IntervalRelation a) -> Set (IntervalRelation a)
- union :: Set (IntervalRelation a) -> Set (IntervalRelation a) -> Set (IntervalRelation a)
- converse :: Set (IntervalRelation a) -> Set (IntervalRelation a)
- equals :: ComparativePredicateOf (Interval a)
- meets, metBy :: ComparativePredicateOf (Interval a)
- before, after :: ComparativePredicateOf (Interval a)
- overlaps, overlappedBy :: ComparativePredicateOf (Interval a)
- starts, startedBy :: ComparativePredicateOf (Interval a)
- precedes, precededBy :: ComparativePredicateOf (Interval a)
- finishes, finishedBy :: ComparativePredicateOf (Interval a)
- during, contains :: ComparativePredicateOf (Interval a)
- unionPredicates :: [ComparativePredicateOf (Interval a)] -> ComparativePredicateOf (Interval a)
- (<|>) :: ComparativePredicateOf (Interval a) -> ComparativePredicateOf (Interval a) -> ComparativePredicateOf (Interval a)
- disjointRelations :: Set (IntervalRelation a)
- withinRelations :: Set (IntervalRelation a)
- disjoint :: ComparativePredicateOf (Interval a)
- notDisjoint :: ComparativePredicateOf (Interval a)
- concur :: ComparativePredicateOf (Interval a)
- within :: ComparativePredicateOf (Interval a)
- enclose :: ComparativePredicateOf (Interval a)
- enclosedBy :: ComparativePredicateOf (Interval a)
- class IntervalAlgebraic a => IntervalCombinable a where
- (.+.) :: Interval a -> Interval a -> Maybe (Interval a)
- extenterval :: Interval a -> Interval a -> Interval a
- (><) :: Interval a -> Interval a -> Maybe (Interval a)
- (<+>) :: (Semigroup (f (Interval a)), Applicative f) => Interval a -> Interval a -> f (Interval a)
- intersect :: Interval a -> Interval a -> Maybe (Interval a)
- class (Intervallic a, Num b, Ord b) => Moment a b | a -> b where
- moment :: b
- class (Intervallic a, Moment a b, Num b, Ord b) => IntervalSizeable a b | a -> b where
- data Interval a
- data IntervalRelation a
- type ComparativePredicateOf a = a -> a -> Bool
Classes
class (Ord a, Show a) => Intervallic a where Source #
The
typeclass specifies how an Intervallic
s is constructed.
It also includes functions for getting the Interval
a
and begin
of an end
.Interval
a
Nothing
parseInterval :: a -> a -> Either String (Interval a) Source #
Safely parse a pair of a
s to create an
.Interval
a
unsafeInterval :: a -> a -> Interval a Source #
Create a new
. This function is not safe as it does
not enforce that \(x < y\). Use with caution. It is meant to be helper
function in early prototyping of this package. This function may be
deprecated in future releases.Interval
a
begin :: Interval a -> a Source #
Access the ends of an
.Interval
a
end :: Interval a -> a Source #
Access the ends of an
.Interval
a
Instances
class (Eq a, Intervallic a) => IntervalAlgebraic a where Source #
The
typeclass specifies the functions and relational
operators for interval-based temporal logic. The typeclass defines the
relational operators for intervals, plus other useful utilities such as
IntervalAlgebraic
, disjoint
, and within
.unionPredicates
Nothing
relate :: Interval a -> Interval a -> IntervalRelation a Source #
Compare two intervals to determine their IntervalRelation
.
predicate' :: IntervalRelation a -> ComparativePredicateOf (Interval a) Source #
Maps an IntervalRelation
to its corresponding predicate function.
predicates :: Set (IntervalRelation a) -> [ComparativePredicateOf (Interval a)] Source #
Given a set of IntervalRelation
s return a list of predicate
functions
corresponding to each relation.
predicate :: Set (IntervalRelation a) -> ComparativePredicateOf (Interval a) Source #
Forms a predicate function from the union of a set of IntervalRelation
s.
toSet :: [IntervalRelation a] -> Set (IntervalRelation a) Source #
Shortcut to creating a 'Set IntervalRelation' from a list.
compose :: IntervalRelation a -> IntervalRelation a -> Set (IntervalRelation a) Source #
Compose two interval relations according to the rules of the algebra. The rules are enumerated according to this table.
complement :: Set (IntervalRelation a) -> Set (IntervalRelation a) Source #
Finds the complement of a 'Set IntervalRelation'.
intersection :: Set (IntervalRelation a) -> Set (IntervalRelation a) -> Set (IntervalRelation a) Source #
Find the intersection of two Set
s of IntervalRelation
union :: Set (IntervalRelation a) -> Set (IntervalRelation a) -> Set (IntervalRelation a) Source #
Find the union of two Set
s of IntervalRelation
converse :: Set (IntervalRelation a) -> Set (IntervalRelation a) Source #
Find the converse of a 'Set IntervalRelation'.
equals :: ComparativePredicateOf (Interval a) Source #
Does x equal y?
meets :: ComparativePredicateOf (Interval a) Source #
Does x meet y? Is y metBy x?
metBy :: ComparativePredicateOf (Interval a) Source #
Does x meet y? Is y metBy x?
before :: ComparativePredicateOf (Interval a) Source #
Is x before y? Is x after y?
after :: ComparativePredicateOf (Interval a) Source #
Is x before y? Is x after y?
overlaps :: ComparativePredicateOf (Interval a) Source #
Does x overlap y? Is x overlapped by y?
overlappedBy :: ComparativePredicateOf (Interval a) Source #
Does x overlap y? Is x overlapped by y?
starts :: ComparativePredicateOf (Interval a) Source #
Does x start y? Is x started by y?
startedBy :: ComparativePredicateOf (Interval a) Source #
Does x start y? Is x started by y?
precedes :: ComparativePredicateOf (Interval a) Source #
precededBy :: ComparativePredicateOf (Interval a) Source #
finishes :: ComparativePredicateOf (Interval a) Source #
Does x finish y? Is x finished by y?
finishedBy :: ComparativePredicateOf (Interval a) Source #
Does x finish y? Is x finished by y?
during :: ComparativePredicateOf (Interval a) Source #
Is x during y? Does x contain y?
contains :: ComparativePredicateOf (Interval a) Source #
Is x during y? Does x contain y?
unionPredicates :: [ComparativePredicateOf (Interval a)] -> ComparativePredicateOf (Interval a) Source #
Compose a list of interval relations with _or_ to create a new
. For example,
ComparativePredicateOf
Interval
aunionPredicates [before, meets]
creates a predicate function determining
if one interval is either before or meets another interval.
(<|>) :: ComparativePredicateOf (Interval a) -> ComparativePredicateOf (Interval a) -> ComparativePredicateOf (Interval a) Source #
Operator for composing the union of two predicates
disjointRelations :: Set (IntervalRelation a) Source #
withinRelations :: Set (IntervalRelation a) Source #
disjoint :: ComparativePredicateOf (Interval a) Source #
notDisjoint :: ComparativePredicateOf (Interval a) Source #
Are x and y not disjoint; i.e. do they share any support?
concur :: ComparativePredicateOf (Interval a) Source #
A synonym for notDisjoint
.
within :: ComparativePredicateOf (Interval a) Source #
enclose :: ComparativePredicateOf (Interval a) Source #
Does x enclose y? That is, is y within
x?
enclosedBy :: ComparativePredicateOf (Interval a) Source #
Synonym for within
.
Instances
class IntervalAlgebraic a => IntervalCombinable a where Source #
The
typeclass provides methods for (possibly) combining
two IntervalCombinable
.Interval
s
Nothing
(.+.) :: Interval a -> Interval a -> Maybe (Interval a) Source #
extenterval :: Interval a -> Interval a -> Interval a Source #
Creates a new Interval
spanning the extent x and y
(><) :: Interval a -> Interval a -> Maybe (Interval a) Source #
If x
is before
y
, then form a new Just Interval a
from the
interval in the "gap" between x
and y
from the end
of x
to the
begin
of y
. Otherwise, Nothing
.
(<+>) :: (Semigroup (f (Interval a)), Applicative f) => Interval a -> Interval a -> f (Interval a) Source #
If x
is before
y
, return f x
appended to f y
. Otherwise,
return extenterval
of x
and y
(wrapped in f
). This is useful for
(left) folding over an *ordered* container of Interval
s and combining
intervals when x
is *not* before
y
.
intersect :: Interval a -> Interval a -> Maybe (Interval a) Source #
Forms a Just
new interval from the intersection of two intervals,
provided the intervals are not disjoint.
Instances
class (Intervallic a, Num b, Ord b) => Moment a b | a -> b where Source #
The Moment
class fixes the smallest duration of an 'Intervallic a'.
Nothing
class (Intervallic a, Moment a b, Num b, Ord b) => IntervalSizeable a b | a -> b where Source #
The IntervalSizeable
typeclass provides functions to determine the size of
and to resize an 'Interval a'.
duration :: Interval a -> b Source #
Determine the duration of an 'Interval a'.
Shifts an a
. Most often, the b
will be the same type as a
.
But for example, if a
is Day
then b
could be Int
.
Takes the difference between two a
to return a b
.
expand :: b -> b -> Interval a -> Interval a Source #
Resize an 'Interval a' to by expanding to "left" by l
and to the
"right" by r
. In the case that l
or r
are less than a moment
the respective endpoints are unchanged.
expandl :: b -> Interval a -> Interval a Source #
Expands an 'Interval a' to left by i.
expandr :: b -> Interval a -> Interval a Source #
Expands an 'Interval a' to right by i.
beginerval :: b -> a -> Interval a Source #
Instances
Types
An
is a pair of Interval
aa
s \( (x, y) \text{ where } x < y\). The
class provides a safe Intervallic
function that returns a
parseInterval
error if \(y < x\) and Left
unsafeInterval
as constructor for creating an
interval that may not be valid.
Instances
Eq a => Eq (Interval a) Source # | |
Intervallic a => Ord (Interval a) Source # | Imposes a total ordering on |
(Intervallic a, Show a) => Show (Interval a) Source # | |
Arbitrary (Interval Int) Source # | |
Arbitrary (Interval Day) Source # | |
data IntervalRelation a Source #
The IntervalRelation
type enumerates the thirteen possible ways that two
objects can relate according to the interval algebra.Interval
a
Meets, Metby
x `meets` y y `metBy` x
x: |-----| y: |-----|
Before, After
x `before` y y `after` x
x: |-----| y: |-----|
Overlaps, OverlappedBy
x `overlaps` y y `overlappedBy` x
x: |-----| y: |-----|
Starts, StartedBy
x `starts` y y `startedBy` x
x: |---| y: |-----|
Finishes, FinishedBy
x `finishes` y y `finishedBy` x
x: |---| y: |-----|
During, Contains
x `during` y y `contains` x
x: |-| y: |-----|
Equal
x `equal` y y `equal` x
x: |-----| y: |-----|
Meets | |
MetBy | |
Before | |
After | |
Overlaps | |
OverlappedBy | |
Starts | |
StartedBy | |
Finishes | |
FinishedBy | |
During | |
Contains | |
Equals |
Instances
type ComparativePredicateOf a = a -> a -> Bool Source #
Defines a predicate of two objects of type a
.