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 types that contain
s: Interval
provides an interface to the data structures which contain anIntervallic
.Interval
provides an interface to theIntervalAlgebraic
, the workhorse of Allen's temporal logic.IntervalRelation
s
provides an interface to methods of combining twoIntervalCombinable
.Interval
s
provides methods for measuring and modifying the size of an interval.IntervalSizeable
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 i a where
- getInterval :: i a -> Interval a
- setInterval :: i a -> Interval a -> i a
- begin, end :: i a -> a
- class (Eq (i a), Intervallic i a) => IntervalAlgebraic i a where
- relate :: i a -> i a -> IntervalRelation (i a)
- predicate' :: IntervalRelation (i a) -> ComparativePredicateOf (i a)
- predicates :: Set (IntervalRelation (i a)) -> [ComparativePredicateOf (i a)]
- predicate :: Set (IntervalRelation (i a)) -> ComparativePredicateOf (i a)
- toSet :: [IntervalRelation (i a)] -> Set (IntervalRelation (i a))
- compose :: IntervalRelation (i a) -> IntervalRelation (i a) -> Set (IntervalRelation (i a))
- complement :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a))
- intersection :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a))
- union :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a))
- converse :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a))
- equals :: ComparativePredicateOf (i a)
- meets, metBy :: ComparativePredicateOf (i a)
- before, after :: ComparativePredicateOf (i a)
- overlaps, overlappedBy :: ComparativePredicateOf (i a)
- starts, startedBy :: ComparativePredicateOf (i a)
- precedes, precededBy :: ComparativePredicateOf (i a)
- finishes, finishedBy :: ComparativePredicateOf (i a)
- during, contains :: ComparativePredicateOf (i a)
- unionPredicates :: [ComparativePredicateOf (i a)] -> ComparativePredicateOf (i a)
- (<|>) :: ComparativePredicateOf (i a) -> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
- disjointRelations :: Set (IntervalRelation (i a))
- withinRelations :: Set (IntervalRelation (i a))
- disjoint :: ComparativePredicateOf (i a)
- notDisjoint :: ComparativePredicateOf (i a)
- concur :: ComparativePredicateOf (i a)
- within :: ComparativePredicateOf (i a)
- enclose :: ComparativePredicateOf (i a)
- enclosedBy :: ComparativePredicateOf (i a)
- class IntervalAlgebraic i a => IntervalCombinable i a where
- class (Show a, Ord a, Num b, Ord b) => IntervalSizeable a b | a -> b where
- moment :: b
- moment' :: Intervallic i a => i a -> b
- duration :: Intervallic i a => i a -> b
- add :: b -> a -> a
- diff :: a -> a -> b
- data Interval a
- parseInterval :: (Show a, Ord a) => a -> a -> Either String (Interval a)
- data IntervalRelation a
- type ComparativePredicateOf a = a -> a -> Bool
- expand :: (IntervalSizeable a b, Intervallic i a) => b -> b -> i a -> i a
- expandl :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a
- expandr :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a
- beginerval :: IntervalSizeable a b => b -> a -> Interval a
- enderval :: IntervalSizeable a b => b -> a -> Interval a
- extenterval :: IntervalAlgebraic i a => i a -> i a -> Interval a
Classes
class (Ord a, Show a) => Intervallic i a where Source #
The
typeclass defines how to get and set the Intervallic
Interval
content
of a data structure. It also includes functions for getting the
and
begin
this data.end
getInterval :: i a -> Interval a Source #
Get the interval from an i a
setInterval :: i a -> Interval a -> i a Source #
Set the interval in an i a
Access the ends of an i a
.
Access the ends of an i a
.
Instances
(Ord a, Show a) => Intervallic Interval a Source # | |
(Ord a, Show a) => Intervallic (PairedInterval b) a Source # | |
Defined in IntervalAlgebra.PairedInterval getInterval :: PairedInterval b a -> Interval a Source # setInterval :: PairedInterval b a -> Interval a -> PairedInterval b a Source # begin :: PairedInterval b a -> a Source # end :: PairedInterval b a -> a Source # |
class (Eq (i a), Intervallic i a) => IntervalAlgebraic i a where Source #
The
typeclass specifies the functions and relational
operators for interval-based temporal logic. The typeclass defines the
relational operators for types that contain an IntervalAlgebraic
'Interval a'
, plus other useful
utilities such as
, disjoint
, and within
.unionPredicates
Nothing
relate :: i a -> i a -> IntervalRelation (i a) Source #
Compare two i a
to determine their IntervalRelation
.
predicate' :: IntervalRelation (i a) -> ComparativePredicateOf (i a) Source #
Maps an IntervalRelation
to its corresponding predicate function.
predicates :: Set (IntervalRelation (i a)) -> [ComparativePredicateOf (i a)] Source #
Given a set of IntervalRelation
s return a list of predicate
functions
corresponding to each relation.
predicate :: Set (IntervalRelation (i a)) -> ComparativePredicateOf (i a) Source #
Forms a predicate function from the union of a set of IntervalRelation
s.
toSet :: [IntervalRelation (i a)] -> Set (IntervalRelation (i a)) Source #
Shortcut to creating a 'Set IntervalRelation' from a list.
compose :: IntervalRelation (i a) -> IntervalRelation (i a) -> Set (IntervalRelation (i a)) Source #
Compose two interval relations according to the rules of the algebra. The rules are enumerated according to this table.
complement :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) Source #
Finds the complement of a 'Set IntervalRelation'.
intersection :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) Source #
Find the intersection of two Set
s of IntervalRelation
s.
union :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) Source #
Find the union of two Set
s of IntervalRelation
s.
converse :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a)) Source #
Find the converse of a 'Set IntervalRelation'.
equals :: ComparativePredicateOf (i a) Source #
Does x equal y?
meets :: ComparativePredicateOf (i a) Source #
Does x meet y? Is y metBy x?
metBy :: ComparativePredicateOf (i a) Source #
Does x meet y? Is y metBy x?
before :: ComparativePredicateOf (i a) Source #
Is x before y? Is x after y?
after :: ComparativePredicateOf (i a) Source #
Is x before y? Is x after y?
overlaps :: ComparativePredicateOf (i a) Source #
Does x overlap y? Is x overlapped by y?
overlappedBy :: ComparativePredicateOf (i a) Source #
Does x overlap y? Is x overlapped by y?
starts :: ComparativePredicateOf (i a) Source #
Does x start y? Is x started by y?
startedBy :: ComparativePredicateOf (i a) Source #
Does x start y? Is x started by y?
precedes :: ComparativePredicateOf (i a) Source #
precededBy :: ComparativePredicateOf (i a) Source #
finishes :: ComparativePredicateOf (i a) Source #
Does x finish y? Is x finished by y?
finishedBy :: ComparativePredicateOf (i a) Source #
Does x finish y? Is x finished by y?
during :: ComparativePredicateOf (i a) Source #
Is x during y? Does x contain y?
contains :: ComparativePredicateOf (i a) Source #
Is x during y? Does x contain y?
unionPredicates :: [ComparativePredicateOf (i a)] -> ComparativePredicateOf (i a) Source #
Compose a list of interval relations with _or_ to create a new
. For example,
ComparativePredicateOf
i aunionPredicates [before, meets]
creates a predicate function determining
if one interval is either before or meets another interval.
(<|>) :: ComparativePredicateOf (i a) -> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a) Source #
Operator for composing the union of two predicates
disjointRelations :: Set (IntervalRelation (i a)) Source #
withinRelations :: Set (IntervalRelation (i a)) Source #
disjoint :: ComparativePredicateOf (i a) Source #
notDisjoint :: ComparativePredicateOf (i a) Source #
Are x and y not disjoint; i.e. do they share any support?
concur :: ComparativePredicateOf (i a) Source #
A synonym for notDisjoint
.
within :: ComparativePredicateOf (i a) Source #
enclose :: ComparativePredicateOf (i a) Source #
Does x enclose y? That is, is y within
x?
enclosedBy :: ComparativePredicateOf (i a) Source #
Synonym for within
.
Instances
class IntervalAlgebraic i a => IntervalCombinable i a where Source #
The
typeclass provides methods for (possibly) combining
two IntervalCombinable
i a
s to form an
.Interval
(.+.) :: i a -> i a -> Maybe (i a) Source #
Maybe form a new i a
by the union of two i a
s that meets
.
(><) :: i a -> i a -> Maybe (i 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 (i a)), Applicative f) => i a -> i a -> f (i 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
.
Instances
(Ord a, Show a) => IntervalCombinable Interval a Source # | |
(Ord a, Show a, Eq b, Monoid b) => IntervalCombinable (PairedInterval b) a Source # | |
Defined in IntervalAlgebra.PairedInterval (.+.) :: PairedInterval b a -> PairedInterval b a -> Maybe (PairedInterval b a) Source # (><) :: PairedInterval b a -> PairedInterval b a -> Maybe (PairedInterval b a) Source # (<+>) :: (Semigroup (f (PairedInterval b a)), Applicative f) => PairedInterval b a -> PairedInterval b a -> f (PairedInterval b a) Source # |
class (Show a, Ord a, Num b, Ord b) => IntervalSizeable a b | a -> b where Source #
The IntervalSizeable
typeclass provides functions to determine the size of an
Intervallic
type and to resize an 'Interval a'.
The smallest duration for an 'Interval a'.
moment' :: Intervallic i a => i a -> b Source #
Gives back a moment
based on the input's type.
duration :: Intervallic i a => i a -> b Source #
Determine the duration of an 'i 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
.
Types
An
is a pair of Interval
aa
s \( (x, y) \text{ where } x < y\). The
function that returns parseInterval
error if \(y < x\) and
Left
otherwise. Right
Interval
Instances
parseInterval :: (Show a, Ord a) => a -> a -> Either String (Interval a) Source #
Safely parse a pair of a
s to create an
.Interval
a
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
.
Functions for creating new intervals from existing
expand :: (IntervalSizeable a b, Intervallic i a) => b -> b -> i a -> i a Source #
Resize an 'i 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 :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a Source #
Expands an 'i a' to left by i.
expandr :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a Source #
Expands an 'i a' to right by i.
beginerval :: IntervalSizeable a b => b -> a -> Interval a Source #
enderval :: IntervalSizeable a b => b -> a -> Interval a Source #
extenterval :: IntervalAlgebraic i a => i a -> i a -> Interval a Source #
Creates a new Interval
spanning the extent x and y.