{-|
Module      : Interval Algebra
Description : Implementation of Allen's interval algebra
Copyright   : (c) NoviSci, Inc 2020
Maintainer  : bsaul@novisci.com

The @IntervalAlgebra@ module provides data types and related classes for the
interval-based temporal logic described in [Allen (1983)](https://doi.org/10.1145/182.358434)
and axiomatized in [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x).
A good primer on Allen's algebra can be [found here](https://thomasalspaugh.org/pub/fnd/allen.html).

= Design

The module is built around three typeclasses designed to separate concerns of
constructing, relating, and combining types that contain @'Interval'@s:

1. @'Intervallic'@ provides an interface to the data structures which contain an
@'Interval'@.
2. @'IntervalCombinable'@ provides an interface to methods of combining two
@'Interval's@.
3. @'IntervalSizeable'@ provides methods for measuring and modifying the size of
an interval.

-}

{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

module IntervalAlgebra(

-- * Intervals
Interval
, Intervallic(..)

-- ** Create new intervals
, parseInterval
, beginerval
, enderval

-- ** Modify intervals
, expand
, expandl
, expandr

-- * Interval Algebra

-- ** Interval Relations and Predicates
, IntervalRelation(..)

{- |
=== Meets, Metby

> x meets y
> y metBy x

@
x: |-----|
y:       |-----|
@
-}
, meets      , metBy

{- |
=== Before, After

> x before y
> y after x

@
x: |-----|
y:          |-----|
@
-}
, before     , after

{- |
=== Overlaps, OverlappedBy

> x overlaps y
> y overlappedBy x

@
x: |-----|
y:     |-----|
@
-}
, overlaps   , overlappedBy

{- |
=== Finishes, FinishedBy

> x finishes y
> y finishedBy x

@
x:   |---|
y: |-----|
@
-}
, finishedBy , finishes

{- |
=== During, Contains

> x during y
> y contains x

@
x:   |-|
y: |-----|
@
-}
, contains   , during

{- |
=== Starts, StartedBy

> x starts y
> y startedBy x

@
x: |---|
y: |-----|
@
-}
, starts     , startedBy

{- |
=== Equal

> x equal y
> y equal x

@
x: |-----|
y: |-----|
@
-}
, equals

-- ** Additional predicates and utilities
, disjoint , notDisjoint, concur
, within, enclose, enclosedBy
, (<|>)
, unionPredicates
, ComparativePredicateOf1
, ComparativePredicateOf2

-- ** Algebraic operations
, intervalRelations
, relate
, compose
, complement
, union
, intersection
, converse

-- * Combine two intervals
, IntervalCombinable(..)
, extenterval

-- * Measure an interval
, IntervalSizeable(..)

) where

import Prelude                  ( Eq, Show, Read, Enum(..), Bounded(..)
, Maybe(..), Either(..), String, Bool(..)
, Integer, Int, Num
, map, otherwise, show
, any, negate, not
, replicate
, (++), (==), (&&), (+), (-), (!!))
import Data.Function            ( ($), id, (.), flip ) import Data.Functor ( Functor(fmap) ) import Data.Ord ( Ord(..), Ordering(..), min, max ) import Data.Semigroup ( Semigroup((<>)) ) import qualified Data.Set ( Set , fromList , difference , intersection , union , map , toList ) import Data.Tuple ( fst, snd ) import Data.Time as DT ( Day , addDays , diffDays ) import Control.Applicative ( Applicative(pure) ) {- | An @'Interval' a@ is a pair $$(x, y) \text{ such that } x < y$$. To create intervals use the @'parseInterval'@, @'beginerval'@, or @'enderval'@ functions. -} newtype Interval a = Interval (a, a) deriving (Interval a -> Interval a -> Bool (Interval a -> Interval a -> Bool) -> (Interval a -> Interval a -> Bool) -> Eq (Interval a) forall a. Eq a => Interval a -> Interval a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Interval a -> Interval a -> Bool$c/= :: forall a. Eq a => Interval a -> Interval a -> Bool
== :: Interval a -> Interval a -> Bool
$c== :: forall a. Eq a => Interval a -> Interval a -> Bool Eq) -- | Safely parse a pair of @a@s to create an @'Interval' a@. -- -- >>> parseInterval 0 1 -- Right (0, 1) -- -- >>> parseInterval 1 0 -- Left "0<1" -- parseInterval :: (Show a, Ord a) => a -> a -> Either String (Interval a) parseInterval :: a -> a -> Either String (Interval a) parseInterval a x a y -- TODO: create more general framework for error handling | a y a -> a -> Bool forall a. Ord a => a -> a -> Bool < a x = String -> Either String (Interval a) forall a b. a -> Either a b Left (String -> Either String (Interval a)) -> String -> Either String (Interval a) forall a b. (a -> b) -> a -> b$ a -> String
forall a. Show a => a -> String
show a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
| Bool
otherwise = Interval a -> Either String (Interval a)
forall a b. b -> Either a b
Right (Interval a -> Either String (Interval a))
-> Interval a -> Either String (Interval a)
forall a b. (a -> b) -> a -> b
$(a, a) -> Interval a forall a. (a, a) -> Interval a Interval (a x, a y) intervalBegin :: Interval a -> a intervalBegin :: Interval a -> a intervalBegin (Interval (a, a) x) = (a, a) -> a forall a b. (a, b) -> a fst (a, a) x intervalEnd :: Interval a -> a intervalEnd :: Interval a -> a intervalEnd (Interval (a, a) x) = (a, a) -> a forall a b. (a, b) -> b snd (a, a) x {- | The @'Intervallic'@ typeclass defines how to get and set the 'Interval' content of a data structure. It also includes functions for getting the endpoints of the 'Interval' via @'begin'@ and @'end'@. >>> getInterval (Interval (0, 10)) (0, 10) >>> begin (Interval (0, 10)) 0 >>> end (Interval (0, 10)) 10 -} class (Ord a, Show a) => Intervallic i a where -- | Get the interval from an @i a@. getInterval :: i a -> Interval a -- | Set the interval in an @i a@. setInterval :: i a -> Interval a -> i a -- | Access the endpoints of an @i a@ . begin, end :: i a -> a begin = Interval a -> a forall a. Interval a -> a intervalBegin (Interval a -> a) -> (i a -> Interval a) -> i a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . i a -> Interval a forall (i :: * -> *) a. Intervallic i a => i a -> Interval a getInterval end = Interval a -> a forall a. Interval a -> a intervalEnd (Interval a -> a) -> (i a -> Interval a) -> i a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . i a -> Interval a forall (i :: * -> *) a. Intervallic i a => i a -> Interval a getInterval {- | The 'IntervalRelation' type and the associated predicate functions enumerate the thirteen possible ways that two @'Interval'@ objects may 'relate' according to Allen's interval algebra. Constructors are shown with their corresponding predicate function. -} data IntervalRelation = Meets -- ^ meets | MetBy -- ^ metBy | Before -- ^ before | After -- ^ after | Overlaps -- ^ overlaps | OverlappedBy -- ^ overlappedBy | Starts -- ^ starts | StartedBy -- ^ startedBy | Finishes -- ^ finishes | FinishedBy -- ^ finishedBy | During -- ^ during | Contains -- ^ contains | Equals -- ^ equals deriving (IntervalRelation -> IntervalRelation -> Bool (IntervalRelation -> IntervalRelation -> Bool) -> (IntervalRelation -> IntervalRelation -> Bool) -> Eq IntervalRelation forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: IntervalRelation -> IntervalRelation -> Bool$c/= :: IntervalRelation -> IntervalRelation -> Bool
== :: IntervalRelation -> IntervalRelation -> Bool
$c== :: IntervalRelation -> IntervalRelation -> Bool Eq, Int -> IntervalRelation -> String -> String [IntervalRelation] -> String -> String IntervalRelation -> String (Int -> IntervalRelation -> String -> String) -> (IntervalRelation -> String) -> ([IntervalRelation] -> String -> String) -> Show IntervalRelation forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [IntervalRelation] -> String -> String$cshowList :: [IntervalRelation] -> String -> String
show :: IntervalRelation -> String
$cshow :: IntervalRelation -> String showsPrec :: Int -> IntervalRelation -> String -> String$cshowsPrec :: Int -> IntervalRelation -> String -> String
forall a.
$creadListPrec :: ReadPrec [IntervalRelation] readPrec :: ReadPrec IntervalRelation$creadPrec :: ReadPrec IntervalRelation
$creadList :: ReadS [IntervalRelation] readsPrec :: Int -> ReadS IntervalRelation$creadsPrec :: Int -> ReadS IntervalRelation

instance Bounded IntervalRelation where
minBound :: IntervalRelation
minBound = IntervalRelation
Before
maxBound :: IntervalRelation
maxBound = IntervalRelation
After

instance Enum IntervalRelation where
r = case IntervalRelation
r of
IntervalRelation
Before       -> Int
0
IntervalRelation
Meets        -> Int
1
IntervalRelation
Overlaps     -> Int
2
IntervalRelation
FinishedBy   -> Int
3
IntervalRelation
Contains     -> Int
4
IntervalRelation
Starts       -> Int
5
IntervalRelation
Equals       -> Int
6
IntervalRelation
StartedBy    -> Int
7
IntervalRelation
During       -> Int
8
IntervalRelation
Finishes     -> Int
9
IntervalRelation
OverlappedBy -> Int
10
IntervalRelation
MetBy        -> Int
11
IntervalRelation
After        -> Int
12

toEnum :: Int -> IntervalRelation
toEnum Int
i = case Int
i of
Int
0  -> IntervalRelation
Before
Int
1  -> IntervalRelation
Meets
Int
2  -> IntervalRelation
Overlaps
Int
3  -> IntervalRelation
FinishedBy
Int
4  -> IntervalRelation
Contains
Int
5  -> IntervalRelation
Starts
Int
6  -> IntervalRelation
Equals
Int
7  -> IntervalRelation
StartedBy
Int
8  -> IntervalRelation
During
Int
9 -> IntervalRelation
Finishes
Int
10 -> IntervalRelation
OverlappedBy
Int
11 -> IntervalRelation
MetBy
Int
12 -> IntervalRelation
After

instance Ord IntervalRelation where
compare :: IntervalRelation -> IntervalRelation -> Ordering
compare IntervalRelation
x IntervalRelation
y = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntervalRelation -> Int
forall a. Enum a => a -> Int
x) (IntervalRelation -> Int
forall a. Enum a => a -> Int
y)

-- | Does x meets y? Is x metBy y?
meets, metBy  :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
meets :: ComparativePredicateOf2 (i0 a) (i1 a)
meets i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y
metBy :: ComparativePredicateOf2 (i0 a) (i1 a)
metBy     = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets

-- | Is x before y? Is x after y?
before, after  :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
before :: ComparativePredicateOf2 (i0 a) (i1 a)
before   i0 a
x i1 a
y  = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y
after :: ComparativePredicateOf2 (i0 a) (i1 a)
after         = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before

-- | Does x overlap y? Is x overlapped by y?
overlaps, overlappedBy :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps :: ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i0 a
x i1 a
y  = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y
overlappedBy :: ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy  = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps

-- | Does x start y? Is x started by y?
starts, startedBy, precedes, precededBy :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
starts :: ComparativePredicateOf2 (i0 a) (i1 a)
starts   i0 a
x i1 a
y  = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i1 a
y
startedBy :: ComparativePredicateOf2 (i0 a) (i1 a)
startedBy     = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
precedes :: ComparativePredicateOf2 (i0 a) (i1 a)
precedes      = ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
precededBy :: ComparativePredicateOf2 (i0 a) (i1 a)
precededBy    = ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy

-- | Does x finish y? Is x finished by y?
finishes, finishedBy :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes :: ComparativePredicateOf2 (i0 a) (i1 a)
finishes i0 a
x i1 a
y  = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i1 a
y
finishedBy :: ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy    = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes

-- | Is x during y? Does x contain y?
during, contains :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
during :: ComparativePredicateOf2 (i0 a) (i1 a)
during   i0 a
x i1 a
y  = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i1 a
y
contains :: ComparativePredicateOf2 (i0 a) (i1 a)
contains      = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during

-- | Does x equal y?
equals :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
equals :: ComparativePredicateOf2 (i0 a) (i1 a)
equals   i0 a
x i1 a
y  = i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i1 a
y

-- | Operator for composing the union of two predicates
(<|>) :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> :: ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
(<|>) ComparativePredicateOf2 (i0 a) (i1 a)
f ComparativePredicateOf2 (i0 a) (i1 a)
g = [ComparativePredicateOf2 (i0 a) (i1 a)]
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b.
[ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates [ComparativePredicateOf2 (i0 a) (i1 a)
f, ComparativePredicateOf2 (i0 a) (i1 a)
g]

disjointRelations :: Data.Set.Set IntervalRelation
disjointRelations :: Set IntervalRelation
disjointRelations = [IntervalRelation] -> Set IntervalRelation
toSet [IntervalRelation
Before, IntervalRelation
After, IntervalRelation
Meets, IntervalRelation
MetBy]

withinRelations :: Data.Set.Set IntervalRelation
withinRelations :: Set IntervalRelation
withinRelations = [IntervalRelation] -> Set IntervalRelation
toSet [IntervalRelation
Starts, IntervalRelation
During, IntervalRelation
Finishes, IntervalRelation
Equals]

-- | Are x and y disjoint ('before', 'after', 'meets', or 'metBy')?
disjoint :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint :: ComparativePredicateOf2 (i0 a) (i1 a)
disjoint    = Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
disjointRelations

-- | Are x and y not disjoint (concur); i.e. do they share any support? This is
--   the 'complement' of 'disjoint'.
notDisjoint, concur :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint :: ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint = Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate (Set IntervalRelation -> Set IntervalRelation
complement Set IntervalRelation
disjointRelations)
concur :: ComparativePredicateOf2 (i0 a) (i1 a)
concur      = ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint

-- | Is x entirely *within* (enclosed by) the endpoints of y? That is, 'during',
--   'starts', 'finishes', or 'equals'?
within, enclosedBy:: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
within :: ComparativePredicateOf2 (i0 a) (i1 a)
within     = Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
withinRelations
enclosedBy :: ComparativePredicateOf2 (i0 a) (i1 a)
enclosedBy = ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
within

-- | Does x enclose y? That is, is y 'within' x?
enclose :: (Intervallic i0 a, Intervallic i1 a)=>
ComparativePredicateOf2 (i0 a) (i1 a)
enclose :: ComparativePredicateOf2 (i0 a) (i1 a)
enclose  = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
enclosedBy

-- | The 'Data.Set.Set' of all 'IntervalRelation's.
intervalRelations :: Data.Set.Set IntervalRelation
intervalRelations :: Set IntervalRelation
intervalRelations = [IntervalRelation] -> Set IntervalRelation
forall a. Ord a => [a] -> Set a
Data.Set.fromList ((Int -> IntervalRelation) -> [Int] -> [IntervalRelation]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Int -> IntervalRelation
forall a. Enum a => Int -> a
toEnum [Int
0..Int
12] ::[IntervalRelation])

-- | Find the converse of a single 'IntervalRelation'
converseRelation :: IntervalRelation  -> IntervalRelation
converseRelation :: IntervalRelation -> IntervalRelation
converseRelation IntervalRelation
x = Int -> IntervalRelation
forall a. Enum a => Int -> a
toEnum (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- IntervalRelation -> Int
forall a. Enum a => a -> Int
x)

-- | Shortcut to creating a 'Set IntervalRelation' from a list.
toSet :: [IntervalRelation ] -> Data.Set.Set IntervalRelation
toSet :: [IntervalRelation] -> Set IntervalRelation
toSet = [IntervalRelation] -> Set IntervalRelation
forall a. Ord a => [a] -> Set a
Data.Set.fromList

-- | Compose a list of interval relations with _or_ to create a new
-- @'ComparativePredicateOf1' i a@. For example,
-- @unionPredicates [before, meets]@ creates a predicate function determining
-- if one interval is either before or meets another interval.
unionPredicates :: [ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates :: [ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates [ComparativePredicateOf2 a b]
fs a
x b
y = (ComparativePredicateOf2 a b -> Bool)
-> [ComparativePredicateOf2 a b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ ComparativePredicateOf2 a b
f -> ComparativePredicateOf2 a b
f a
x b
y) [ComparativePredicateOf2 a b]
fs

-- | Maps an 'IntervalRelation' to its corresponding predicate function.
toPredicate :: (Intervallic i0 a, Intervallic i1 a) =>
IntervalRelation
-> ComparativePredicateOf2 (i0 a) (i1 a)
toPredicate :: IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
toPredicate IntervalRelation
r =
case IntervalRelation
r of
IntervalRelation
Before       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
IntervalRelation
Meets        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets
IntervalRelation
Overlaps     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps
IntervalRelation
FinishedBy   -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
IntervalRelation
Contains     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains
IntervalRelation
Starts       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
IntervalRelation
Equals       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals
IntervalRelation
StartedBy    -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy
IntervalRelation
During       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during
IntervalRelation
Finishes     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
IntervalRelation
OverlappedBy -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy
IntervalRelation
MetBy        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy
IntervalRelation
After        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after

-- | Given a set of 'IntervalRelation's return a list of 'predicate' functions
--   corresponding to each relation.
predicates :: (Intervallic i0 a, Intervallic i1 a)=>
Data.Set.Set IntervalRelation
-> [ComparativePredicateOf2 (i0 a) (i1 a)]
predicates :: Set IntervalRelation -> [ComparativePredicateOf2 (i0 a) (i1 a)]
predicates Set IntervalRelation
x = (IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a))
-> [IntervalRelation] -> [ComparativePredicateOf2 (i0 a) (i1 a)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
toPredicate (Set IntervalRelation -> [IntervalRelation]
forall a. Set a -> [a]
Data.Set.toList Set IntervalRelation
x)

-- | Forms a predicate function from the union of a set of 'IntervalRelation's.
predicate :: (Intervallic i0 a, Intervallic i1 a)=>
Data.Set.Set IntervalRelation
-> ComparativePredicateOf2 (i0 a) (i1 a)
predicate :: Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate = [ComparativePredicateOf2 (i0 a) (i1 a)]
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b.
[ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates([ComparativePredicateOf2 (i0 a) (i1 a)]
-> ComparativePredicateOf2 (i0 a) (i1 a))
-> (Set IntervalRelation
-> [ComparativePredicateOf2 (i0 a) (i1 a)])
-> Set IntervalRelation
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set IntervalRelation -> [ComparativePredicateOf2 (i0 a) (i1 a)]
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
Set IntervalRelation -> [ComparativePredicateOf2 (i0 a) (i1 a)]
predicates

-- | The lookup table for the compositions of interval relations.
composeRelationLookup :: [[[IntervalRelation]]]
composeRelationLookup :: [[[IntervalRelation]]]
composeRelationLookup =
[ [[IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p , [IntervalRelation]
p    , [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
full ]
, [[IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
m    , [IntervalRelation]
m , [IntervalRelation]
m    , [IntervalRelation]
osd  , [IntervalRelation]
osd  , [IntervalRelation]
osd  , [IntervalRelation]
fef  , [IntervalRelation]
dsomp]
, [[IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
pmo  , [IntervalRelation]
pmo  , [IntervalRelation]
pmofd, [IntervalRelation]
o    , [IntervalRelation]
o , [IntervalRelation]
ofd  , [IntervalRelation]
osd  , [IntervalRelation]
osd  , [IntervalRelation]
cncr , [IntervalRelation]
dso  , [IntervalRelation]
dsomp]
, [[IntervalRelation]
p    , [IntervalRelation]
m    , [IntervalRelation]
o    , [IntervalRelation]
f'   , [IntervalRelation]
d'   , [IntervalRelation]
o    , [IntervalRelation]
f', [IntervalRelation]
d'   , [IntervalRelation]
osd  , [IntervalRelation]
fef  , [IntervalRelation]
dso  , [IntervalRelation]
dso  , [IntervalRelation]
dsomp]
, [[IntervalRelation]
pmofd, [IntervalRelation]
ofd  , [IntervalRelation]
ofd  , [IntervalRelation]
d'   , [IntervalRelation]
d'   , [IntervalRelation]
ofd  , [IntervalRelation]
d', [IntervalRelation]
d'   , [IntervalRelation]
cncr , [IntervalRelation]
dso  , [IntervalRelation]
dso  , [IntervalRelation]
dso  , [IntervalRelation]
dsomp]
, [[IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
pmo  , [IntervalRelation]
pmo  , [IntervalRelation]
pmofd, [IntervalRelation]
s    , [IntervalRelation]
s , [IntervalRelation]
ses  , [IntervalRelation]
d    , [IntervalRelation]
d    , [IntervalRelation]
dfo  , [IntervalRelation]
m'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
p    , [IntervalRelation]
m    , [IntervalRelation]
o    , [IntervalRelation]
f'   , [IntervalRelation]
d'   , [IntervalRelation]
s    , [IntervalRelation]
e , [IntervalRelation]
s'   , [IntervalRelation]
d    , [IntervalRelation]
f    , [IntervalRelation]
o'   , [IntervalRelation]
m'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
pmofd, [IntervalRelation]
ofd  , [IntervalRelation]
ofd  , [IntervalRelation]
d'   , [IntervalRelation]
d'   , [IntervalRelation]
ses  , [IntervalRelation]
s', [IntervalRelation]
s'   , [IntervalRelation]
dfo  , [IntervalRelation]
o'   , [IntervalRelation]
o'   , [IntervalRelation]
m'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
p    , [IntervalRelation]
p    , [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
full , [IntervalRelation]
d    , [IntervalRelation]
d , [IntervalRelation]
dfomp, [IntervalRelation]
d    , [IntervalRelation]
d    , [IntervalRelation]
dfomp, [IntervalRelation]
p'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
p    , [IntervalRelation]
m    , [IntervalRelation]
osd  , [IntervalRelation]
fef  , [IntervalRelation]
dsomp, [IntervalRelation]
d    , [IntervalRelation]
f , [IntervalRelation]
omp  , [IntervalRelation]
d    , [IntervalRelation]
f    , [IntervalRelation]
omp  , [IntervalRelation]
p'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
pmofd, [IntervalRelation]
ofd  , [IntervalRelation]
cncr , [IntervalRelation]
dso  , [IntervalRelation]
dsomp, [IntervalRelation]
dfo  , [IntervalRelation]
o', [IntervalRelation]
omp  , [IntervalRelation]
dfo  , [IntervalRelation]
o'   , [IntervalRelation]
omp  , [IntervalRelation]
p'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
pmofd, [IntervalRelation]
ses  , [IntervalRelation]
dfo  , [IntervalRelation]
m'   , [IntervalRelation]
p'   , [IntervalRelation]
dfo  , [IntervalRelation]
m', [IntervalRelation]
p'   , [IntervalRelation]
dfo  , [IntervalRelation]
m'   , [IntervalRelation]
p'   , [IntervalRelation]
p'   , [IntervalRelation]
p'   ]
, [[IntervalRelation]
full , [IntervalRelation]
dfomp, [IntervalRelation]
dfomp, [IntervalRelation]
p'   , [IntervalRelation]
p'   , [IntervalRelation]
dfomp, [IntervalRelation]
p', [IntervalRelation]
p'   , [IntervalRelation]
dfomp, [IntervalRelation]
p'   , [IntervalRelation]
p'   , [IntervalRelation]
p'   , [IntervalRelation]
p'   ]
]
where p :: [IntervalRelation]
p  = [IntervalRelation
Before]
m :: [IntervalRelation]
m  = [IntervalRelation
Meets]
o :: [IntervalRelation]
o  = [IntervalRelation
Overlaps]
f' :: [IntervalRelation]
f' = [IntervalRelation
FinishedBy]
d' :: [IntervalRelation]
d' = [IntervalRelation
Contains]
s :: [IntervalRelation]
s  = [IntervalRelation
Starts]
e :: [IntervalRelation]
e  = [IntervalRelation
Equals]
s' :: [IntervalRelation]
s' = [IntervalRelation
StartedBy]
d :: [IntervalRelation]
d  = [IntervalRelation
During]
f :: [IntervalRelation]
f  = [IntervalRelation
Finishes]
o' :: [IntervalRelation]
o' = [IntervalRelation
OverlappedBy]
m' :: [IntervalRelation]
m' = [IntervalRelation
MetBy]
p' :: [IntervalRelation]
p' = [IntervalRelation
After]
ses :: [IntervalRelation]
ses    = [IntervalRelation]
s [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
e [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s'
fef :: [IntervalRelation]
fef    = [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
e [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f
pmo :: [IntervalRelation]
pmo    = [IntervalRelation]
p [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o
pmofd :: [IntervalRelation]
pmofd  = [IntervalRelation]
pmo [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d'
osd :: [IntervalRelation]
osd    = [IntervalRelation]
o [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d
ofd :: [IntervalRelation]
ofd    = [IntervalRelation]
o [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d'
omp :: [IntervalRelation]
omp    = [IntervalRelation]
o' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'
dfo :: [IntervalRelation]
dfo    = [IntervalRelation]
d [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o'
dfomp :: [IntervalRelation]
dfomp  = [IntervalRelation]
dfo [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'
dso :: [IntervalRelation]
dso    = [IntervalRelation]
d' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o'
dsomp :: [IntervalRelation]
dsomp  = [IntervalRelation]
dso [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'
pmosd :: [IntervalRelation]
pmosd  = [IntervalRelation]
p [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
osd
cncr :: [IntervalRelation]
cncr = [IntervalRelation]
o [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
e [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o'
full :: [IntervalRelation]
full = [IntervalRelation]
p [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
cncr [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'

-- | Compare two @i a@ to determine their 'IntervalRelation'.
--
-- >>> relate (Interval (0::Int, 1)) (Interval (1, 2))
-- Meets
--
-- >>> relate (Interval (1::Int, 2)) (Interval (0, 1))
-- MetBy
--
relate :: (Intervallic i0 a, Intervallic i1 a) => i0 a -> i1 a -> IntervalRelation
relate :: i0 a -> i1 a -> IntervalRelation
relate i0 a
x i1 a
y
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before i1 a
y       = IntervalRelation
Before
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after  i1 a
y       = IntervalRelation
After
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets  i1 a
y       = IntervalRelation
Meets
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy  i1 a
y       = IntervalRelation
MetBy
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i1 a
y     = IntervalRelation
Overlaps
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy i1 a
y = IntervalRelation
OverlappedBy
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts i1 a
y       = IntervalRelation
Starts
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy i1 a
y    = IntervalRelation
StartedBy
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes i1 a
y     = IntervalRelation
Finishes
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy i1 a
y   = IntervalRelation
FinishedBy
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during i1 a
y       = IntervalRelation
During
| i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains i1 a
y     = IntervalRelation
Contains
| Bool
otherwise          = IntervalRelation
Equals

-- | Compose two interval relations according to the rules of the algebra.
--   The rules are enumerated according to <https://thomasalspaugh.org/pub/fnd/allen.html#BasicCompositionsTable this table>.
compose :: IntervalRelation
-> IntervalRelation
-> Data.Set.Set IntervalRelation
compose :: IntervalRelation -> IntervalRelation -> Set IntervalRelation
compose IntervalRelation
x IntervalRelation
y = [IntervalRelation] -> Set IntervalRelation
toSet ([[[IntervalRelation]]]
composeRelationLookup [[[IntervalRelation]]] -> Int -> [[IntervalRelation]]
forall a. [a] -> Int -> a
!! IntervalRelation -> Int
forall a. Enum a => a -> Int
x [[IntervalRelation]] -> Int -> [IntervalRelation]
forall a. [a] -> Int -> a
!! IntervalRelation -> Int
forall a. Enum a => a -> Int
y)

-- | Finds the complement of a @'Data.Set.Set' 'IntervalRelation'@.
complement :: Data.Set.Set IntervalRelation -> Data.Set.Set IntervalRelation
complement :: Set IntervalRelation -> Set IntervalRelation
complement = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set IntervalRelation
intervalRelations

-- | Find the intersection of two 'Data.Set.Set's of 'IntervalRelation's.
intersection ::  Data.Set.Set IntervalRelation
-> Data.Set.Set IntervalRelation
-> Data.Set.Set IntervalRelation
intersection :: Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
intersection = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.intersection

-- | Find the union of two 'Data.Set.Set's of 'IntervalRelation's.
union :: Data.Set.Set IntervalRelation
-> Data.Set.Set IntervalRelation
-> Data.Set.Set IntervalRelation
union :: Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
union = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.union

-- | Find the converse of a @'Data.Set.Set' 'IntervalRelation'@.
converse :: Data.Set.Set IntervalRelation
-> Data.Set.Set IntervalRelation
converse :: Set IntervalRelation -> Set IntervalRelation
converse = (IntervalRelation -> IntervalRelation)
-> Set IntervalRelation -> Set IntervalRelation
forall b a. Ord b => (a -> b) -> Set a -> Set b
Data.Set.map IntervalRelation -> IntervalRelation
converseRelation

{- |
The 'IntervalSizeable' typeclass provides functions to determine the size of an
'Intervallic' type and to resize an 'Interval a'.
-}
class (Show a, Ord a, Num b, Ord b) => IntervalSizeable a b| a -> b where

-- | The smallest duration for an 'Interval a'.
moment :: b
moment = b
1

-- | Gives back a 'moment' based on the input's type.
moment' :: Intervallic i a => i a -> b
moment' i a
x = forall b. IntervalSizeable a b => b
forall a b. IntervalSizeable a b => b
moment @a

-- | Determine the duration of an @'i a'@.
duration :: Intervallic i a => i a -> b
duration i a
x = a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i a
x)

-- | 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'.
add :: b -> a -> a

-- | Takes the difference between two @a@ to return a @b@.
diff :: a -> a -> b

-- | 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.
--
-- >>> expand 0 0 (Interval (0::Int, 2::Int))
-- (0, 2)
--
-- >>> expand 1 1 (Interval (0::Int, 2::Int))
-- (-1, 3)
--
expand :: (IntervalSizeable a b, Intervallic i a) =>
b -- ^ duration to subtract from the 'begin'
-> b -- ^ duration to add to the 'end'
-> i a
-> i a
expand :: b -> b -> i a -> i a
expand b
l b
r i a
p = i a -> Interval a -> i a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval i a
p Interval a
i
where s :: b
s = if b
l b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
moment' i a
p then b
0 else b -> b
forall a. Num a => a -> a
negate b
l
e :: b
e = if b
r b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
moment' i a
p then b
0 else b
r
i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
s (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin i a p, b -> a -> a forall a b. IntervalSizeable a b => b -> a -> a add b e (a -> a) -> a -> a forall a b. (a -> b) -> a -> b$ i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i a
p)

-- | Expands an @i a@ to "left".
--
-- >>> expandl 2 (Interval (0::Int, 2::Int))
-- (-2, 2)
--
expandl :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a
expandl :: b -> i a -> i a
expandl b
i = b -> b -> i a -> i a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
b -> b -> i a -> i a
expand b
i b
0

-- | Expands an @i a@ to "right".
--
-- >>> expandr 2 (Interval (0::Int, 2::Int))
-- (0, 4)
--
expandr :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a
expandr :: b -> i a -> i a
expandr = b -> b -> i a -> i a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
b -> b -> i a -> i a
expand b
0

-- | Safely creates an 'Interval a' using @x@ as the 'begin' and adding
--   @max 'moment' dur@ to @x@ as the 'end'.
--
-- >>> beginerval (0::Int) (0::Int)
-- (0, 1)
--
-- >>> beginerval (1::Int) (0::Int)
-- (0, 1)
--
-- >>> beginerval (2::Int) (0::Int)
-- (0, 2)
--
beginerval :: (IntervalSizeable a b) =>
b -- ^ @dur@ation to add to the 'begin'
-> a -- ^ the 'begin' point of the 'Interval'
-> Interval a
beginerval :: b -> a -> Interval a
beginerval b
dur a
x = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
y)
where i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)
d :: b
d = b -> b -> b
forall a. Ord a => a -> a -> a
max (Interval a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
moment' Interval a
i) b
dur
y :: a
y = b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
d a
x

-- | Safely creates an 'Interval a' using @x@ as the 'end' and adding
--   @negate max 'moment' dur@ to @x@ as the 'begin'.
--
-- >>> enderval (0::Int) (0::Int)
-- (-1, 0)
--
-- >>> enderval (1::Int) (0::Int)
-- (-1, 0)
--
-- >>> enderval (2::Int) (0::Int)
-- (-2, 0)
--
enderval :: (IntervalSizeable a b) =>
b -- ^ @dur@ation to subtract from the 'end'
-> a -- ^ the 'end' point of the 'Interval'
-> Interval a
enderval :: b -> a -> Interval a
enderval b
dur a
x = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
forall a. Num a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$b -> b -> b forall a. Ord a => a -> a -> a max (Interval a -> b forall a b (i :: * -> *). (IntervalSizeable a b, Intervallic i a) => i a -> b moment' Interval a i) b dur) a x, a x) where i :: Interval a i = (a, a) -> Interval a forall a. (a, a) -> Interval a Interval (a x, a x) -- | Creates a new @Interval@ spanning the extent x and y. -- -- >>> extenterval (Interval (0, 1)) (Interval (9, 10)) -- (0, 10) -- extenterval :: Intervallic i a => i a -> i a -> Interval a extenterval :: i a -> i a -> Interval a extenterval i a x i a y = (a, a) -> Interval a forall a. (a, a) -> Interval a Interval (a s, a e) where s :: a s = a -> a -> a forall a. Ord a => a -> a -> a min (i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin i a x) (i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin i a y) e :: a e = a -> a -> a forall a. Ord a => a -> a -> a max (i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end i a x) (i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end i a y) {- | The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining two @i a@s to form an @'Interval'@. -} class (Intervallic i a) => IntervalCombinable i a where -- | Maybe form a new @i a@ by the union of two @i a@s that 'meets'. (.+.) :: i a -> i a -> Maybe (i a) (.+.) i a x i a y | i a x ComparativePredicateOf2 (i a) (i a) forall (i0 :: * -> *) a (i1 :: * -> *). (Intervallic i0 a, Intervallic i1 a) => ComparativePredicateOf2 (i0 a) (i1 a) meets i a y = i a -> Maybe (i a) forall a. a -> Maybe a Just (i a -> Maybe (i a)) -> i a -> Maybe (i a) forall a b. (a -> b) -> a -> b$ i a -> Interval a -> i a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval i a
y (Interval a -> i a) -> Interval a -> i a
forall a b. (a -> b) -> a -> b
$(a, a) -> Interval a forall a. (a, a) -> Interval a Interval (a b, a e) | Bool otherwise = Maybe (i a) forall a. Maybe a Nothing where b :: a b = i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin i a x e :: a e = i a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end i a y -- | 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'. (><) :: i a -> i a -> Maybe (i a) -- | 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@. (<+>):: ( Semigroup (f (i a)), Applicative f) => i a -> i a -> f (i a) {- Misc -} -- | Defines a predicate of two objects of type @a@. type ComparativePredicateOf1 a = (a -> a -> Bool) -- | Defines a predicate of two object of different types. type ComparativePredicateOf2 a b = (a -> b -> Bool) -- {- -- Instances -- -} -- | Imposes a total ordering on @'Interval' a@ based on first ordering the -- 'begin's then the 'end's. instance (Eq (Interval a), Intervallic Interval a) => Ord (Interval a) where <= :: Interval a -> Interval a -> Bool (<=) Interval a x Interval a y | Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a x a -> a -> Bool forall a. Ord a => a -> a -> Bool < Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a y = Bool True | Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a y = Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end Interval a x a -> a -> Bool forall a. Ord a => a -> a -> Bool <= Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end Interval a y | Bool otherwise = Bool False < :: Interval a -> Interval a -> Bool (<) Interval a x Interval a y | Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a x a -> a -> Bool forall a. Ord a => a -> a -> Bool < Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a y = Bool True | Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a y = Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end Interval a x a -> a -> Bool forall a. Ord a => a -> a -> Bool < Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end Interval a y | Bool otherwise = Bool False instance Functor Interval where fmap :: (a -> b) -> Interval a -> Interval b fmap a -> b f (Interval (a x, a y)) = (b, b) -> Interval b forall a. (a, a) -> Interval a Interval (a -> b f a x, a -> b f a y) instance (Intervallic Interval a) => Show (Interval a) where show :: Interval a -> String show Interval a x = String "(" String -> String -> String forall a. [a] -> [a] -> [a] ++ a -> String forall a. Show a => a -> String show (Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a begin Interval a x) String -> String -> String forall a. [a] -> [a] -> [a] ++ String ", " String -> String -> String forall a. [a] -> [a] -> [a] ++ a -> String forall a. Show a => a -> String show (Interval a -> a forall (i :: * -> *) a. Intervallic i a => i a -> a end Interval a x) String -> String -> String forall a. [a] -> [a] -> [a] ++ String ")" instance (Ord a, Show a) => Intervallic Interval a where getInterval :: Interval a -> Interval a getInterval = Interval a -> Interval a forall a. a -> a id setInterval :: Interval a -> Interval a -> Interval a setInterval Interval a _ Interval a x = Interval a x instance (Ord a, Show a) => IntervalCombinable Interval a where >< :: Interval a -> Interval a -> Maybe (Interval a) (><) Interval a x Interval a y | Interval a x ComparativePredicateOf2 (Interval a) (Interval a) forall (i0 :: * -> *) a (i1 :: * -> *). (Intervallic i0 a, Intervallic i1 a) => ComparativePredicateOf2 (i0 a) (i1 a) before Interval a y = Interval a -> Maybe (Interval a) forall a. a -> Maybe a Just (Interval a -> Maybe (Interval a)) -> Interval a -> Maybe (Interval a) forall a b. (a -> b) -> a -> b$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Interval a
x, Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Interval a
y)
| Bool
otherwise    = Maybe (Interval a)
forall a. Maybe a
Nothing

<+> :: Interval a -> Interval a -> f (Interval a)
(<+>) Interval a
x Interval a
y
| Interval a
x ComparativePredicateOf2 (Interval a) (Interval a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before Interval a
y = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval Interval a
x ) f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval Interval a
y )
| Bool
otherwise    = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Interval a -> Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> i a -> Interval a
extenterval Interval a
x Interval a
y )

instance IntervalSizeable Int Int where
moment :: Int
moment = Int
1
add :: Int -> Int -> Int
add    = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
diff :: Int -> Int -> Int
diff   = (-)

instance IntervalSizeable Integer Integer where
moment :: Integer
moment = Integer
1
add :: Integer -> Integer -> Integer
add    = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
diff :: Integer -> Integer -> Integer
diff   = (-)

instance IntervalSizeable DT.Day Integer where
moment :: Integer
moment = Integer
1
add :: Integer -> Day -> Day
add    = Integer -> Day -> Day