interval-algebra 0.7.1 → 0.8.0

raw patch · 9 files changed

+644/−650 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• README.md +4/−15
• interval-algebra.cabal +1/−1
• src/IntervalAlgebra.hs +443/−341
• src/IntervalAlgebra/IntervalUtilities.hs +134/−235
• src/IntervalAlgebra/PairedInterval.hs +9/−23
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +11/−10
• test/IntervalAlgebra/PairedIntervalSpec.hs +4/−3
• test/IntervalAlgebraSpec.hs +32/−22

@@ -1,5 +1,11 @@ # Changelog for interval-algebra +## 0.8.0++* Removes the `IntervalAlgebraic` typeclass. The functions that were in this class are now regular functions exported in the main module.+* Generalizes all interval predicate functions to work on (potentially) two different `Intervallic` containers.+* Cleans up and reorganizes documentation.+ ## 0.7.1  * Adds `Safe` language extension to all library modules.

@@ -1,28 +1,17 @@ # interval-algebra -The `interval-algebra` package implements [Allen's interval algebra](https://www.ics.uci.edu/~alspaugh/cls/shr/allen.html) in [Haskell](https://www.haskell.org). The main 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).+The `interval-algebra` package implements [Allen's interval algebra](https://www.ics.uci.edu/~alspaugh/cls/shr/allen.html) in [Haskell](https://www.haskell.org). The main 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 four typeclasses designed to separate concerns of constructing, relating, and combining types that contain `Interval`s:+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. `IntervalAlgebraic` provides an interface to the `IntervalRelation`, the workhorse of Allen's temporal logic.-3. `IntervalCombinable` provides an interface to methods of combining two `Interval`s.-4. `IntervalSizeable` provides methods for measuring and modifying the size of 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.  An advantage of nested typeclass design is that developers can define an `Interval` of type `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` `Interval`s. Namely, the ordering is based on first ordering the `begin`s then the `end`s.- ## Axiom tests  The package [includes tests](test/IntervalAlgebraSpec.hs) that the functions of the `IntervalAlgebraic` typeclass meets the axioms for _intervals_ (not points) as laid out in [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x).--## Development--This module is under development and the API may change in the future.

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           interval-algebra-version:        0.7.1+version:        0.8.0 synopsis:       An implementation of Allen's interval algebra for temporal logic description:    Please see the README on GitHub at <https://github.com/novisci/interval-algebra> category:       Algebra,Time

@@ -4,40 +4,24 @@ Copyright   : (c) NoviSci, Inc 2020 License     : BSD3 Maintainer  : bsaul@novisci.com-Stability   : experimental  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 four typeclasses designed to separate concerns of +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. @'IntervalAlgebraic'@ provides an interface to the @'IntervalRelation's@, -   the workhorse of Allen's temporal logic.-3. @'IntervalCombinable'@ provides an interface to methods of combining two+2. @'IntervalCombinable'@ provides an interface to methods of combining two    @'Interval's@.-4. @'IntervalSizeable'@ provides methods for measuring and modifying the size of+3. @'IntervalSizeable'@ provides methods for measuring and modifying the size of     an interval. -An advantage of nested typeclass design is that developers can define an -@'Interval'@ of type @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'@ -@'Interval'@s. Namely, the ordering is based on first ordering the 'begin's -then the 'end's.--= Development--This module is under development and the API may change in the future. -}  {-# LANGUAGE Safe #-}@@ -45,184 +29,252 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-} --- {-# LANGUAGE MonoLocalBinds #-} module IntervalAlgebra( -    -- * Classes-      Intervallic(..)-    , IntervalAlgebraic(..)-    , IntervalCombinable(..)-    , IntervalSizeable(..)+    -- * Intervals+      Interval+    , Intervallic(..) -    -- * Types-    , Interval+    -- ** Create new intervals     , parseInterval-    , IntervalRelation(..)-    , ComparativePredicateOf+    , beginerval+    , enderval -    -- * Functions for creating new intervals from existing    +    -- ** Modify intervals       , expand     , expandl     , expandr-    , beginerval-    , enderval-    , extenterval-) where -import Prelude (Eq, Ord, Show, Read, Enum(..), Bounded(..), Ordering (LT)-               , Maybe(..), Either(..), String, Integer, Int, Bool(..), Num-               , Foldable (maximum, minimum, foldMap, foldr)-               , map, otherwise, flip, show, fst, snd, min, max, any, negate, not-               , replicate, id, uncurry-               , (++), (==), (&&), (<), (>), (<=), ($), (+), (-), (.), (!!))-import Data.Monoid ( (<>), Monoid )               -import Data.Functor ( Functor(fmap) )-import Data.Time as DT ( Day, addDays, diffDays, addGregorianYearsClip, calendarYear )-import Data.Semigroup ( Semigroup((<>)) )-import Data.Set(Set, fromList, difference, intersection, union, map, toList)-import Data.Ord( Ord(..), Ordering(..))-import Control.Applicative (Applicative(pure))+    -- * Interval Algebra  -{- | An @'Interval' a@ is a pair of @a@s \( (x, y) \text{ where } x < y\). The-@'parseInterval'@ function that returns @'Left'@ error if \(y < x\) and-@'Right' 'Interval'@ otherwise. --}-newtype Interval a = Interval (a, a) deriving (Eq)-    --- | Safely parse a pair of @a@s to create an @'Interval' a@.-parseInterval :: (Show a, Ord a) => a -> a -> Either String (Interval a)-parseInterval x y-    -- TODO: create more general framework for error handling-    |  y < x    = Left  $ show y ++ "<" ++ show x-    | otherwise = Right $ Interval (x, y)+    -- ** Interval Relations and Predicates+    , IntervalRelation(..) -intervalBegin :: Interval a -> a-intervalBegin (Interval x) = fst x+    {- |+    === Meets, Metby -intervalEnd :: Interval a -> a-intervalEnd (Interval x) = snd x+    > x `meets` y+    > y `metBy` x -{- | -The @'Intervallic'@ typeclass defines how to get and set the 'Interval' content-of a data structure. It also includes functions for getting the @'begin'@ and -@'end'@ this data.--}-class (Ord a, Show a) => Intervallic i a where+    @ +    x: |-----|+    y:       |-----| +    @+    -}+    , meets      , metBy -    -- | Get the interval from an @i a@-    getInterval :: i a -> Interval a+    {- |+    === Before, After -    -- | Set the interval in an @i a@-    setInterval :: i a -> Interval a -> i a+    > x `before` y+    > y `after` x -    -- | Access the ends of an @i a@ .-    begin, end :: i a -> a-    begin = intervalBegin . getInterval-    end   = intervalEnd . getInterval+    @ +    x: |-----|  +    y:          |-----|+    @+    -}+    , before     , after -{- | +    {- |+    === Overlaps, OverlappedBy -The 'IntervalRelation' type enumerates the thirteen possible ways that two -@'Interval' a@ objects can relate according to the interval algebra.+    > x `overlaps` y+    > y `overlappedBy` x -=== Meets, Metby+    @ +    x: |-----|+    y:     |-----|+    @+    -}+    , overlaps   , overlappedBy -> x `meets` y-> y `metBy` x+    {- |+    === Finishes, FinishedBy -@ -x: |-----|-y:       |-----| -@+    > x `finishes` y+    > y `finishedBy` x -=== Before, After+    @ +    x:   |---| +    y: |-----|+    @+    -}+    , finishedBy , finishes -> x `before` y-> y `after` x+    {- |+    === During, Contains -@ -x: |-----|  -y:          |-----|-@+    > x `during` y+    > y `contains` x +    @ +    x:   |-| +    y: |-----|+    @+    -}+    , contains   , during -=== Overlaps, OverlappedBy+    {- |+    === Starts, StartedBy -> x `overlaps` y-> y `overlappedBy` x+    > x `starts` y+    > y `startedBy` x -@ -x: |-----|-y:     |-----|-@+    @ +    x: |---| +    y: |-----|+    @+    -}+    , starts     , startedBy -=== Starts, StartedBy+    {- |+    === Equal -> x `starts` y-> y `startedBy` x+    > x `equal` y+    > y `equal` x -@ -x: |---| -y: |-----|-@+    @ +    x: |-----| +    y: |-----|+    @+    -}+    , equals -=== Finishes, FinishedBy+    -- ** Additional predicates and utilities+    , disjoint , notDisjoint, concur+    , within, enclose, enclosedBy+    , (<|>)+    , unionPredicates+    , ComparativePredicateOf1+    , ComparativePredicateOf2 -> x `finishes` y-> y `finishedBy` x+    -- ** Algebraic operations+    , intervalRelations+    , relate+    , compose+    , complement+    , union+    , intersection+    , converse -@ -x:   |---| -y: |-----|-@+    -- * Combine two intervals+    , IntervalCombinable(..)+    , extenterval -=== During, Contains+    -- * Measure an interval+    , IntervalSizeable(..) -> x `during` y-> y `contains` x+) where -@ -x:   |-| -y: |-----|-@+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) ) -=== Equal+{- | 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 (Eq) -> x `equal` y-> y `equal` x+-- | 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 x y+    -- TODO: create more general framework for error handling+    |  y < x    = Left  $ show y ++ "<" ++ show x+    | otherwise = Right $ Interval (x, y) -@ -x: |-----| -y: |-----|-@+intervalBegin :: Interval a -> a+intervalBegin (Interval x) = fst x +intervalEnd :: Interval a -> a+intervalEnd (Interval x) = snd 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 -}-data IntervalRelation a =-      Meets-    | MetBy-    | Before-    | After-    | Overlaps-    | OverlappedBy-    | Starts-    | StartedBy-    | Finishes-    | FinishedBy-    | During-    | Contains-    | Equals+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 = intervalBegin . getInterval+    end   = intervalEnd . 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 (Eq, Show, Read) -instance Bounded (IntervalRelation a) where+instance Bounded IntervalRelation where     minBound = Before     maxBound = After -instance Enum (IntervalRelation a) where+instance Enum IntervalRelation where     fromEnum r = case r of                     Before       -> 0                     Meets        -> 1@@ -253,19 +305,143 @@                11 -> MetBy                12 -> After -instance Ord (IntervalRelation a) where+instance Ord IntervalRelation where     compare x y = compare (fromEnum x) (fromEnum y) --- | The 'Set' of all 'IntervalRelation's.-intervalRelations :: Set (IntervalRelation a)-intervalRelations = fromList (Prelude.map toEnum [0..12] ::[IntervalRelation a])+-- | Does x `meets` y? Is x metBy y?+meets, metBy  :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+meets x y = end x == begin y+metBy     = flip meets +-- | Is x before y? Is x after y?+before, after  :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+before   x y  = end x < begin y+after         = flip before++-- | Does x overlap y? Is x overlapped by y?+overlaps, overlappedBy :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+overlaps x y  = begin x < begin y && end x < end y && end x > begin y+overlappedBy  = flip 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   x y  = begin x == begin y && end x < end y+startedBy     = flip starts+precedes      = starts+precededBy    = startedBy++-- | Does x finish y? Is x finished by y?+finishes, finishedBy :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+finishes x y  = begin x > begin y && end x == end y+finishedBy    = flip finishes++-- | Is x during y? Does x contain y?+during, contains :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+during   x y  = begin x > begin y && end x < end y+contains      = flip during++-- | Does x equal y?+equals :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+equals   x y  = begin x == begin y && end x == end 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)+(<|>) f g = unionPredicates [f, g]++disjointRelations :: Data.Set.Set IntervalRelation+disjointRelations = toSet [Before, After, Meets, MetBy]++withinRelations :: Data.Set.Set IntervalRelation+withinRelations = toSet [Starts, During, Finishes, Equals]++-- | Are x and y disjoint ('before', 'after', 'meets', or 'metBy')?+disjoint :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+disjoint    = predicate 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 = predicate (complement disjointRelations)+concur      = 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     = predicate withinRelations+enclosedBy = within++-- | Does x enclose y? That is, is y 'within' x?+enclose :: (Intervallic i0 a, Intervallic i1 a)=>+    ComparativePredicateOf2 (i0 a) (i1 a)+enclose  = flip enclosedBy++-- | The 'Data.Set.Set' of all 'IntervalRelation's.+intervalRelations :: Data.Set.Set IntervalRelation+intervalRelations = Data.Set.fromList (Prelude.map toEnum [0..12] ::[IntervalRelation])+ -- | Find the converse of a single 'IntervalRelation'-converseRelation :: IntervalRelation a -> IntervalRelation a+converseRelation :: IntervalRelation  -> IntervalRelation converseRelation x = toEnum (12 - fromEnum x) +-- | Shortcut to creating a 'Set IntervalRelation' from a list.+toSet :: [IntervalRelation ] -> Data.Set.Set IntervalRelation+toSet = 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 fs x y = any (\ f -> f x y) fs++-- | Maps an 'IntervalRelation' to its corresponding predicate function.+toPredicate :: (Intervallic i0 a, Intervallic i1 a) =>+           IntervalRelation+        -> ComparativePredicateOf2 (i0 a) (i1 a)+toPredicate r =+    case r of+        Before       -> before+        Meets        -> meets+        Overlaps     -> overlaps+        FinishedBy   -> finishedBy+        Contains     -> contains+        Starts       -> starts+        Equals       -> equals+        StartedBy    -> startedBy+        During       -> during+        Finishes     -> finishes+        OverlappedBy -> overlappedBy+        MetBy        -> metBy+        After        -> 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 x = Prelude.map toPredicate (Data.Set.toList 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 = unionPredicates.predicates+ -- | The lookup table for the compositions of interval relations.-composeRelationLookup :: [[[IntervalRelation a]]]+composeRelationLookup :: [[[IntervalRelation]]] composeRelationLookup =       [ [p    , p    , p    , p    , p    , p    , p , p    , pmosd, pmosd, pmosd, pmosd, full ]       , [p    , p    , p    , p    , p    , m    , m , m    , osd  , osd  , osd  , fef  , dsomp]@@ -308,187 +484,58 @@             pmosd  = p ++ m ++ osd             cncr = o ++ f' ++ d' ++ s ++ e ++ s' ++ d ++ f ++ o'             full = p ++ m ++ cncr ++ m' ++ p'-{--Misc--} --- | Defines a predicate of two objects of type @a@.-type ComparativePredicateOf a = (a -> a -> Bool)---{- |-The @'IntervalAlgebraic'@ typeclass specifies the functions and relational -operators for interval-based temporal logic. The typeclass defines the -relational operators for types that contain an @'Interval a'@, plus other useful- utilities such as @'disjoint'@, @'within'@, and @'unionPredicates'@.--}-class (Eq (i a), Intervallic i a) => IntervalAlgebraic i a where--    -- | Compare two @i a@ to determine their 'IntervalRelation'.-    relate :: i a -> i a -> IntervalRelation (i a)-    relate x y-        | x `before` y       = Before-        | x `after`  y       = After-        | x `meets`  y       = Meets-        | x `metBy`  y       = MetBy-        | x `overlaps` y     = Overlaps-        | x `overlappedBy` y = OverlappedBy-        | x `starts` y       = Starts-        | x `startedBy` y    = StartedBy-        | x `finishes` y     = Finishes-        | x `finishedBy` y   = FinishedBy-        | x `during` y       = During-        | x `contains` y     = Contains-        | otherwise          = Equals--    -- | Maps an 'IntervalRelation' to its corresponding predicate function.-    predicate' :: IntervalRelation (i a) -> ComparativePredicateOf (i a)-    predicate' r =-        case r of-            Before       -> before-            Meets        -> meets-            Overlaps     -> overlaps-            FinishedBy   -> finishedBy-            Contains     -> contains-            Starts       -> starts-            Equals       -> equals-            StartedBy    -> startedBy-            During       -> during-            Finishes     -> finishes-            OverlappedBy -> overlappedBy-            MetBy        -> metBy-            After        -> after--    -- | Given a set of 'IntervalRelation's return a list of 'predicate' functions -    --   corresponding to each relation.-    predicates :: Set (IntervalRelation (i a)) -> [ComparativePredicateOf (i a)]-    predicates x = Prelude.map predicate' (toList x)--    -- | Forms a predicate function from the union of a set of 'IntervalRelation's.-    predicate :: Set (IntervalRelation (i a)) -> ComparativePredicateOf (i a)-    predicate = unionPredicates.predicates--    -- ** Algebraic operations on IntervalRelations--    -- | Shortcut to creating a 'Set IntervalRelation' from a list.-    toSet :: [IntervalRelation (i a)] -> Set (IntervalRelation (i a))-    toSet = fromList--    -- | 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 (i a)-            -> IntervalRelation (i a)-            -> Set (IntervalRelation (i a))-    compose x y = toSet ((composeRelationLookup !! fromEnum x) !! fromEnum y)--    -- | Finds the complement of a 'Set IntervalRelation'.-    complement :: Set (IntervalRelation (i a)) -> Set (IntervalRelation (i a))-    complement = difference intervalRelations--    -- | Find the intersection of two 'Set's of 'IntervalRelation's.-    intersection ::  Set (IntervalRelation (i a))-                  -> Set (IntervalRelation (i a))-                  -> Set (IntervalRelation (i a))-    intersection = Data.Set.intersection--    -- | Find the union of two 'Set's of 'IntervalRelation's.-    union ::  Set (IntervalRelation (i a))-           -> Set (IntervalRelation (i a))-           -> Set (IntervalRelation (i a))-    union = Data.Set.union--    -- | Find the converse of a 'Set IntervalRelation'. -    converse ::   Set (IntervalRelation (i a))-                  -> Set (IntervalRelation (i a))-    converse = Data.Set.map converseRelation--    -- ** Interval algebra predicates--    -- | Does x equal y?-    equals                 :: ComparativePredicateOf (i a)-    equals   x y  = begin x == begin y && end x == end y--    -- | Does x meet y? Is y metBy x?-    meets, metBy           :: ComparativePredicateOf (i a)-    meets    x y  = end x == begin y-    metBy         = flip meets--    -- | Is x before y? Is x after y?-    before, after          :: ComparativePredicateOf (i a)-    before   x y  = end x < begin y-    after         = flip before--    -- | Does x overlap y? Is x overlapped by y?-    overlaps, overlappedBy :: ComparativePredicateOf (i a)-    overlaps x y  = begin x < begin y && end x < end y && end x > begin y-    overlappedBy  = flip overlaps--    -- | Does x start y? Is x started by y?-    starts, startedBy      :: ComparativePredicateOf (i a)-    starts   x y  = begin x == begin y && (end x < end y)-    startedBy     = flip starts--    -- | Synonyms for 'starts' and 'startedBy'-    precedes, precededBy      :: ComparativePredicateOf (i a)-    precedes      = starts-    precededBy    = startedBy--    -- | Does x finish y? Is x finished by y?-    finishes, finishedBy   :: ComparativePredicateOf (i a)-    finishes x y  = begin x > begin y && end x == end y-    finishedBy    = flip finishes--    -- | Is x during y? Does x contain y?-    during, contains       :: ComparativePredicateOf (i a)-    during   x y  = begin x > begin y && end x < end y-    contains      = flip during--    -- ** Interval Algebra utilities--    -- | Compose a list of interval relations with _or_ to create a new-    -- @'ComparativePredicateOf' i a@. For example, -    -- @unionPredicates [before, meets]@ creates a predicate function determining-    -- if one interval is either before or meets another interval.-    unionPredicates       :: [ComparativePredicateOf (i a)] ->-                              ComparativePredicateOf (i a)-    unionPredicates fs x y = any (\ f -> f x y) fs--    -- | Operator for composing the union of two predicates-    (<|>) ::  ComparativePredicateOf (i a)-        -> ComparativePredicateOf (i a)-        -> ComparativePredicateOf (i a)-    (<|>) f g = unionPredicates [f, g]--    disjointRelations :: Set (IntervalRelation (i a))-    disjointRelations = toSet [Before, After, Meets, MetBy]--    withinRelations :: Set (IntervalRelation (i a))-    withinRelations = toSet [Starts, During, Finishes, Equals]--    -- | Are x and y disjoint ('before', 'after', 'meets', or 'metBy')?-    disjoint               :: ComparativePredicateOf (i a)-    disjoint = predicate disjointRelations+-- | 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 x y+    | x `before` y       = Before+    | x `after`  y       = After+    | x `meets`  y       = Meets+    | x `metBy`  y       = MetBy+    | x `overlaps` y     = Overlaps+    | x `overlappedBy` y = OverlappedBy+    | x `starts` y       = Starts+    | x `startedBy` y    = StartedBy+    | x `finishes` y     = Finishes+    | x `finishedBy` y   = FinishedBy+    | x `during` y       = During+    | x `contains` y     = Contains+    | otherwise          = Equals -    -- | Are x and y not disjoint; i.e. do they share any support?-    notDisjoint            :: ComparativePredicateOf (i a)-    notDisjoint = predicate (complement disjointRelations)+-- | 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 x y = toSet (composeRelationLookup !! fromEnum x !! fromEnum y) -    -- | A synonym for 'notDisjoint'.-    concur                 :: ComparativePredicateOf (i a)-    concur = notDisjoint+-- | Finds the complement of a @'Data.Set.Set' 'IntervalRelation'@.+complement :: Data.Set.Set IntervalRelation -> Data.Set.Set IntervalRelation+complement = Data.Set.difference intervalRelations -    -- | Is x entirely *within* the endpoints of y? That is, 'during', -    --   'starts', 'finishes', or 'equals'?-    within                 :: ComparativePredicateOf (i a)-    within = predicate withinRelations+-- | 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 = Data.Set.intersection -    -- | Does x enclose y? That is, is y 'within' x?-    enclose                :: ComparativePredicateOf (i a)-    enclose = flip enclosedBy+-- | 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 = Data.Set.union -    -- | Synonym for 'within'.-    enclosedBy             :: ComparativePredicateOf (i a)-    enclosedBy = within+-- | Find the converse of a @'Data.Set.Set' 'IntervalRelation'@. +converse :: Data.Set.Set IntervalRelation+         -> Data.Set.Set IntervalRelation+converse = Data.Set.map converseRelation  {- | The 'IntervalSizeable' typeclass provides functions to determine the size of an@@ -515,49 +562,97 @@     -- | 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 +-- | 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 :: (IntervalSizeable a b, Intervallic i a) => b -> b -> i a -> i a+--+-- >>> 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 l r p = setInterval p i   where s = if l < moment' p then 0 else negate l         e = if r < moment' p then 0 else r         i = Interval (add s $ begin p, add e $ end p) --- | Expands an 'i a' to left by i.+-- | 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 i = expand i 0 --- | Expands an 'i a' to right by i.+-- | 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 = expand 0  -- | Safely creates an 'Interval a' using @x@ as the 'begin' and adding ---   @max moment dur@ to @x@ as the 'end'.-beginerval :: (IntervalSizeable a b) => b -> a -> Interval a+--   @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 dur x = Interval (x, y)     where i = Interval (x, x)           d = max (moment' i) dur           y = add d x  -- | Safely creates an 'Interval a' using @x@ as the 'end' and adding---   @negate max moment dur@ to @x@ as the 'begin'.-enderval :: (IntervalSizeable a b) => b -> a -> Interval a+--   @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 dur x = Interval (add (negate $ max (moment' i) dur) x, x)     where i = Interval (x, x)  -- | Creates a new @Interval@ spanning the extent x and y.-extenterval :: IntervalAlgebraic i a => i a -> i a -> Interval a+--+-- >>> extenterval (Interval (0, 1)) (Interval (9, 10))+-- (0, 10)+--+extenterval :: Intervallic i a => i a -> i a -> Interval a extenterval x y = Interval (s, e)     where s = min (begin x) (begin y)           e = max (end x) (end y) - {- | The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining two @i a@s to form an @'Interval'@. -}-class (IntervalAlgebraic i a) => IntervalCombinable i a where+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)@@ -571,7 +666,7 @@     --   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 @@ -581,7 +676,16 @@             -> 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 -- -}@@ -607,8 +711,6 @@ instance (Ord a, Show a) => Intervallic Interval a where     getInterval = id     setInterval _ x = x--instance (Eq a, Ord a, Show a) => IntervalAlgebraic Interval a  instance (Ord a, Show a) => IntervalCombinable Interval a where     (><) x y

@@ -16,27 +16,27 @@ {-# LANGUAGE MonoLocalBinds #-}  module IntervalAlgebra.IntervalUtilities (-      relations-    , relations'-    , intersect-    , combineIntervals++    -- * Fold over sequential intervals+      combineIntervals     , combineIntervals'     , gaps     , gaps'-    , durations-    , clip     , gapsWithin++    -- * Operations on Meeting sequences of paired intervals+    , foldMeetingSafe+    , formMeetingSequence++    -- * Withering functions++    -- ** Clear containers based on predicate     , nothingIf     , nothingIfNone     , nothingIfAny     , nothingIfAll -    -- * Operations on Meeting sequences of intervals-    , foldMeetingSafe-    , formMeetingSequence--    -- * Filtering functions-    , compareIntervals+    -- ** Filter containers based on predicate     , filterBefore     , filterMeets     , filterOverlaps@@ -57,6 +57,12 @@     , filterEnclose     , filterEnclosedBy +    -- * Misc utilities+    , relations+    , relations'+    , intersect+    , clip+    , durations ) where  import Prelude          ( (<*>), seq)@@ -78,21 +84,43 @@ import Data.Tuple       ( fst ) import Safe             ( headMay, lastMay, initSafe, tailSafe) import Witherable       ( Filterable(filter) )-import IntervalAlgebra  ( Interval-                        , Intervallic(..)-                        , IntervalAlgebraic(..)-                        , IntervalCombinable(..)-                        , IntervalSizeable(..)-                        , IntervalRelation(..)-                        , ComparativePredicateOf-                        , beginerval-                        , enderval-                        , extenterval )+import IntervalAlgebra  ( (<|>),+                          after,+                          before,+                          beginerval,+                          concur,+                          contains,+                          disjoint,+                          during,+                          enclose,+                          enclosedBy,+                          enderval,+                          equals,+                          extenterval,+                          finishedBy,+                          finishes,+                          meets,+                          metBy,+                          notDisjoint,+                          overlappedBy,+                          overlaps,+                          relate,+                          startedBy,+                          starts,+                          within,+                          ComparativePredicateOf1,+                          ComparativePredicateOf2,+                          Interval,+                          IntervalCombinable((<+>), (><)),+                          IntervalRelation(Meets),+                          IntervalSizeable(diff, duration),+                          Intervallic(..) ) import IntervalAlgebra.PairedInterval                         ( PairedInterval-                        , mkPairedInterval+                        , makePairedInterval                         , getPairData                         , equalPairData )+ ------------------------------------------------- -- Unexported utilties used in functions below -- -------------------------------------------------@@ -101,6 +129,7 @@ iv :: Int -> Int -> Interval Int iv = beginerval +-- TODO: does this function and applyAccume reinvent an existing foldable function? -- Fold over consecutive pairs of foldable structure and collect the results in  -- a monoidal structure. foldlAccume :: (Foldable f, Applicative m, Monoid (m a))=>@@ -141,9 +170,9 @@ -- -- >>> relations [iv 1 0, iv 1 1]  -- [Meets]-relations :: (IntervalAlgebraic i a, Foldable f)=>+relations :: (Foldable f, Intervallic i a )=>        f (i a)-    -> [IntervalRelation (i a)]+    -> [IntervalRelation] relations = relations'  -- | A generic form of 'relations' which can output any 'Applicative' and @@ -151,17 +180,20 @@ -- >>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)] -- [Meets] ---relations' :: ( IntervalAlgebraic i a-              , Foldable f+relations' :: ( Foldable f               , Applicative m-              , Monoid (m (IntervalRelation (i a))) )=>+              , Intervallic i a+              , Monoid (m IntervalRelation ))=>         f (i a)-     -> m (IntervalRelation (i a))+     -> m IntervalRelation relations' = foldlAccume relate  -- | Forms a 'Just' new interval from the intersection of two intervals,  --   provided the intervals are not disjoint.-intersect :: (IntervalSizeable a b, IntervalAlgebraic i a) => +-- +-- >>> intersect (iv 5 0) (iv 2 3)+-- Just (3, 5)+intersect :: (Intervallic i a, IntervalSizeable a b) =>      i a -> i a -> Maybe (Interval a) intersect x y     | disjoint x y = Nothing@@ -211,7 +243,7 @@ -- -- >>> clip (iv 3 0) (iv 2 4) -- Nothing-clip :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>+clip :: (IntervalSizeable a b)=>        Interval a     -> Interval a     -> Maybe (Interval a)@@ -231,14 +263,12 @@ -- -- >>> gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12] -- Just [(5, 7),(9, 10)]--- gapsWithin :: ( Applicative f                , Foldable f                , Monoid (f (Interval a))                , IntervalSizeable a b                , IntervalCombinable Interval a-               , Filterable f-               , IntervalAlgebraic Interval a)=>+               , Filterable f)=>      Interval a     -- ^ i   -> f (Interval a) -- ^ x   -> Maybe (f (Interval a))@@ -266,8 +296,8 @@ -- -- >>> combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13] -- [(0, 12),(13, 15)]-combineIntervals :: ( IntervalAlgebraic Interval a-                    , Applicative f+combineIntervals :: ( Applicative f+                    , Intervallic Interval a                     , Monoid (f (Interval a))                     , Foldable f ) =>       f (Interval a) ->@@ -280,8 +310,7 @@ -- -- >>> 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]+combineIntervals' :: (Intervallic Interval a)=> [Interval a] -> [Interval a] combineIntervals' l = unBox $ foldl' (<>) (Box []) (packBoxes l)  -- Internal function for combining maybe intervals in the 'combineIntervals'' @@ -295,12 +324,10 @@ (<->) (Just x) Nothing  = [x] (<->) (Just x) (Just y) = (<+>) x y -- -- | 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.-nothingIf :: (Monoid (f (i a)), Filterable f, IntervalAlgebraic i a)=>+nothingIf :: (Monoid (f (i a)), Filterable f)=>      ((i a -> Bool) -> f (i a) -> Bool) -- ^ e.g. 'any' or 'all'   -> (i a -> Bool) -- ^ predicate to apply to each element of input list   -> f (i a)@@ -321,209 +348,82 @@ -- >>> nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5] -- Just [(3, 6),(5, 6)] ---nothingIfNone :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>+nothingIfNone :: (Monoid (f (i a)), Foldable f, Filterable f)=>     (i a -> Bool) -- ^ predicate to apply to each element of input list   -> f (i a)   -> Maybe (f (i a)) nothingIfNone = nothingIf (\f x -> (not.any f) x)  -- | Returns 'Nothing' if *any* of the element of input satisfy the predicate condition.-nothingIfAny :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>+--+-- >>> nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 1 5]+-- Just [(3, 6),(5, 6)]+--+-- >>> nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 1 5]+-- Nothing+nothingIfAny :: (Monoid (f (i a)), Foldable f, Filterable f)=>     (i a -> Bool) -- ^ predicate to apply to each element of input list   -> f (i a)   -> Maybe (f (i a)) nothingIfAny = nothingIf any --- | Returns 'Nothing' if *all* of the element of input satisfy the predicate condition-nothingIfAll :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>+-- | Returns 'Nothing' if *all* of the element of input satisfy the predicate condition.+-- >>> nothingIfAll (starts (iv 2 3)) [iv 3 3, iv 4 3]+-- Nothing+nothingIfAll :: (Monoid (f (i a)), Foldable f, Filterable f)=>     (i a -> Bool) -- ^ predicate to apply to each element of input list   -> f (i a)   -> Maybe (f (i a)) nothingIfAll = nothingIf all -{- | -Filter functions provides means for filtering 'Filterable' containers of -@'Intervallic i a'@s based on @'IntervalAlgebraic'@ relations.--}---- | Lifts a predicate to be able to compare two different 'IntervalAlgebraic' ---   structure by comparing the intervals contain within each. -compareIntervals :: (IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>-   ComparativePredicateOf (Interval a)-    -> i0 a-    -> i1 a-    -> Bool-compareIntervals pf x y = pf (getInterval x) (getInterval y)- -- | Creates a function for filtering a 'Witherable.Filterable' of @i1 a@s  --   by comparing the @Interval a@s that of an @i0 a@. -filterMaker :: (Filterable f-                , IntervalAlgebraic Interval a-                , IntervalAlgebraic i0 a-                , IntervalAlgebraic i1 a) =>-        ComparativePredicateOf (Interval a)+makeFilter :: ( Filterable f+               , Intervallic i0 a+               , Intervallic i1 a) =>+        ComparativePredicateOf2 (i0 a) (i1 a)       -> i0 a       -> (f (i1 a) -> f (i1 a))-filterMaker f p = Witherable.filter (compareIntervals f p)---- | Filter by 'overlaps'.-filterOverlaps :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterOverlaps = filterMaker overlaps---- | Filter by 'overlappedBy'.-filterOverlappedBy :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterOverlappedBy = filterMaker overlappedBy---- | Filter by 'before'.-filterBefore :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterBefore = filterMaker before---- | Filter by 'after'.-filterAfter :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterAfter = filterMaker after---- | Filter by 'starts'.-filterStarts :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterStarts = filterMaker starts---- | Filter by 'startedBy'.-filterStartedBy :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterStartedBy = filterMaker startedBy---- | Filter by 'finishes'.-filterFinishes :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterFinishes = filterMaker finishes---- | Filter by'finishedBy'.-filterFinishedBy :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterFinishedBy = filterMaker finishedBy---- | Filter by 'meets'.-filterMeets :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterMeets = filterMaker meets---- | Filter by 'metBy'.-filterMetBy :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterMetBy = filterMaker metBy---- | Filter by 'during'.-filterDuring :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterDuring = filterMaker during---- | Filter by 'contains'.-filterContains :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterContains = filterMaker contains---- | Filter by 'equals'.-filterEquals :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterEquals = filterMaker equals---- | Filter by 'disjoint'.-filterDisjoint :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterDisjoint = filterMaker disjoint---- | Filter by 'notDisjoint'.-filterNotDisjoint :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterNotDisjoint = filterMaker notDisjoint---- | Filter by 'concur'.-filterConcur ::  (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterConcur = filterMaker concur---- | Filter by 'within'.-filterWithin :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterWithin = filterMaker within---- | Filter by 'enclose'.-filterEnclose :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterEnclose = filterMaker enclose+makeFilter f p = Witherable.filter (f p) --- | Filter by 'enclosedBy'.-filterEnclosedBy :: (Filterable f-                  , IntervalAlgebraic Interval a-                  , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) =>-                  i0 a -> f (i1 a) -> f (i1 a)-filterEnclosedBy = filterMaker enclosedBy+{- | +Filter 'Filterable' containers of one @'Intervallic'@ type based by comparing to +a (potentially different) 'Intervallic' type using the corresponding interval+predicate function.+-}+filterOverlaps, filterOverlappedBy, filterBefore, filterAfter, +  filterStarts, filterStartedBy, filterFinishes, filterFinishedBy, +  filterMeets, filterMetBy, filterDuring, filterContains, filterEquals,+  filterDisjoint, filterNotDisjoint, filterConcur, filterWithin,+  filterEnclose, filterEnclosedBy :: +    ( Filterable f , Intervallic i0 a, Intervallic i1 a) =>+    i0 a -> f (i1 a) -> f (i1 a)+filterOverlaps          = makeFilter overlaps+filterOverlappedBy      = makeFilter overlappedBy+filterBefore            = makeFilter before+filterAfter             = makeFilter after+filterStarts            = makeFilter starts+filterStartedBy         = makeFilter startedBy+filterFinishes          = makeFilter finishes+filterFinishedBy        = makeFilter finishedBy+filterMeets             = makeFilter meets+filterMetBy             = makeFilter metBy+filterDuring            = makeFilter during+filterContains          = makeFilter contains+filterEquals            = makeFilter equals+filterDisjoint          = makeFilter disjoint+filterNotDisjoint       = makeFilter notDisjoint+filterConcur            = makeFilter concur+filterWithin            = makeFilter within+filterEnclose           = makeFilter enclose+filterEnclosedBy        = makeFilter enclosedBy  -- | 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. -foldMeetingSafe :: ( IntervalAlgebraic (PairedInterval b) a, Eq b) =>+foldMeetingSafe :: (Intervallic (PairedInterval b) a,  Eq b) =>            [ PairedInterval b a ] -- ^ Be sure this only contains intervals                                    --   that sequentially 'meets'.         -> [ PairedInterval b a ]@@ -532,7 +432,7 @@ -- | Folds over a list of Meeting Paired Intervals and in the case that the 'getPairData'  --   is equal between two sequential meeting intervals, these two intervals are  --   combined into one.  -foldMeeting :: ( IntervalAlgebraic (PairedInterval b) a, Eq b) =>+foldMeeting :: (Eq b, Ord a, Show a) =>             Meeting [PairedInterval b a ]         ->  Meeting [PairedInterval b a ] foldMeeting (Meeting l) = foldl' joinMeetingPairedInterval (Meeting []) (packMeeting l)@@ -546,7 +446,7 @@ packMeeting = Data.List.map (\z -> Meeting [z])  -- Test a list of intervals to be sure they all meet; if not return Nothing.-parseMeeting :: (IntervalAlgebraic i a)=> [i a] -> Maybe (Meeting [i a])+parseMeeting :: Intervallic i a => [i a] -> Maybe (Meeting [i a]) parseMeeting x     | all ( == Meets ) (relations x) = Just $ Meeting x     | otherwise = Nothing@@ -559,8 +459,8 @@ joinMeetingPairedInterval = joinMeeting equalPairData  -- A general function for combining any two @Meeting [i a]@ by 'listCombiner'.-joinMeeting :: (IntervalAlgebraic i a) =>-       ComparativePredicateOf (i a)+joinMeeting :: Intervallic i a =>+       ComparativePredicateOf1 (i a)     -> Meeting [ i a ]     -> Meeting [ i a ]     -> Meeting [ i a ]@@ -568,8 +468,8 @@  -- The intervals @x@ and @y@ should meet! The predicate function @p@ determines -- when the two intervals that meet should be combined.-join2MeetingWhen :: (IntervalAlgebraic i a) =>-       ComparativePredicateOf (i a)+join2MeetingWhen :: Intervallic i a => +       ComparativePredicateOf1 (i a)     -> Maybe (i a)     -> Maybe (i a)     -> [i a]@@ -589,7 +489,6 @@ -} disjoinPaired :: ( Eq b                  , Monoid b-                 , IntervalAlgebraic (PairedInterval b) a                  , IntervalSizeable a c) =>        (PairedInterval b) a     -> (PairedInterval b) a@@ -613,7 +512,7 @@          b2 = begin y          e1 = end x          e2 = end y-         ev = flip mkPairedInterval+         ev = flip makePairedInterval          evp = \b e s -> ev (beginerval (diff e b) b) s  {- | @@ -624,16 +523,16 @@ compared to input events. The second of the pair are disjoint events that still need to be compared to be input events.  -}-mtEvt :: ( Monoid b, Eq b, IntervalSizeable a c) =>+recurseDisjoin :: ( Monoid b, Eq b, IntervalSizeable a c) =>        ([(PairedInterval b) a ], [(PairedInterval b) a ])     -> [(PairedInterval b) a ]     -> [(PairedInterval b) a ]-mtEvt (acc, o:os) []     = acc ++ o:os           -- the "final" pattern-mtEvt (acc, [])   []     = acc                 -- another "final" pattern -mtEvt (acc, [])   (e:es) = mtEvt (acc, [e]) es -- the "initialize" pattern-mtEvt (acc, o:os) (e:es)                       -- the "operating" patterns +recurseDisjoin (acc, o:os) []     = acc ++ o:os           -- the "final" pattern+recurseDisjoin (acc, [])   []     = acc                 -- another "final" pattern +recurseDisjoin (acc, [])   (e:es) = recurseDisjoin (acc, [e]) es -- the "initialize" pattern+recurseDisjoin (acc, o:os) (e:es)                       -- the "operating" patterns       -- If input event is equal to the first comparator, skip the comparison.-    | e == o    = mtEvt (acc, o:os) es+    | e == o    = recurseDisjoin (acc, o:os) es       {- If the period of o is either before or meets the period of e, then       the first of the combined events can be put into the accumulator. @@ -641,10 +540,10 @@      is before or meets e, then we are assured that all periods up to the       beginning of o are fully disjoint and subsequent input events will       not overlap these in any way. -}-    | (before <|> meets) o e = mtEvt (acc ++ nh, mtEvt ([], nt) os ) es+    | (before <|> meets) o e = recurseDisjoin (acc ++ nh, recurseDisjoin ([], nt) os ) es      --The standard recursive operation.-    | otherwise = mtEvt (acc,  mtEvt ([], n) os ) es+    | otherwise = recurseDisjoin (acc,  recurseDisjoin ([], n) os ) es   where n  = getMeeting $ disjoinPaired o e         nh = maybeToList (headMay n)         nt = tailSafe n@@ -662,8 +561,8 @@                        , IntervalSizeable a c) =>            [ PairedInterval b a ]         -> [ PairedInterval b a ]-formMeetingSequence x = mtEvt ([], []) (mtEvt ([], []) x) -   -- the second pass of mtEvt is to handle the situation where the first pass+formMeetingSequence x = recurseDisjoin ([], []) (recurseDisjoin ([], []) x) +   -- the second pass of recurseDisjoin is to handle the situation where the first pass    -- disjoins all the events correctly into a meeting sequence but -- due to     -- nesting of intervals in the input -- some of the sequential pairs have    -- the same data after the first pass. The second pass merges any sequential

@@ -15,20 +15,19 @@ module IntervalAlgebra.PairedInterval (       PairedInterval     , Empty-    , mkPairedInterval+    , makePairedInterval     , getPairData     , intervals     , equalPairData     , toTrivialPair     , trivialize-    -- , makePairPredicate ) where  import IntervalAlgebra  ( Interval                         , Intervallic(..)-                        , IntervalAlgebraic(..)+                        , before                         , IntervalCombinable(..)-                        , ComparativePredicateOf+                        , ComparativePredicateOf1                         , extenterval ) import Witherable       ( Filterable(filter) ) import Data.Bifunctor   ( Bifunctor(bimap) )@@ -50,31 +49,29 @@   (<=) x y = getInterval x <= getInterval y   (<) x y  = getInterval x <  getInterval y -instance (Eq b, Show a, Ord a) => IntervalAlgebraic (PairedInterval b) a - instance (Show b, Show a, Ord a) => Show (PairedInterval b a) where     show x = "{" ++ show (getInterval x) ++ ", " ++ show (getPairData x) ++ "}"  instance (Ord a, Show a, Eq b, Monoid b) =>            IntervalCombinable (PairedInterval b) a where-    (><) x y = fmap (mkPairedInterval mempty) (getInterval x >< getInterval y)+    (><) x y = fmap (makePairedInterval mempty) (getInterval x >< getInterval y)      (<+>) x y         | x `before` y = pure x <> pure y-        | otherwise    = pure $ mkPairedInterval (getPairData x <> getPairData y)+        | otherwise    = pure $ makePairedInterval (getPairData x <> getPairData y)                                                  (extenterval x y)    -- | Make a paired interval. -mkPairedInterval :: b -> Interval a -> PairedInterval b a-mkPairedInterval d i = PairedInterval (i, d)+makePairedInterval :: b -> Interval a -> PairedInterval b a+makePairedInterval d i = PairedInterval (i, d)  -- | Gets the data (i.e. non-interval) part of a @PairedInterval@. getPairData :: PairedInterval b a -> b getPairData (PairedInterval (_, y)) = y  -- | Tests for equality of the data in a @PairedInterval@.-equalPairData :: (Eq b) => ComparativePredicateOf (PairedInterval b a)+equalPairData :: (Eq b) => ComparativePredicateOf1 (PairedInterval b a) equalPairData x y = getPairData x == getPairData y  -- | Gets the intervals from a list of paired intervals.@@ -92,20 +89,9 @@ -- | Lifts an @Interval a@ into a @PairedInterval Empty a@, where @Empty@ is a --   trivial type that contains no data. toTrivialPair :: Interval a -> PairedInterval Empty a-toTrivialPair = mkPairedInterval Empty+toTrivialPair = makePairedInterval Empty  -- | Lifts a @Functor@ containing @Interval a@(s) into a @Functor@ containing --   @PairedInterval Empty a@(s). trivialize :: Functor f => f (Interval a) -> f (PairedInterval Empty a) trivialize = fmap toTrivialPair---- | Takes a predicate of intervals and a predicate on the data part of a ---   paired interval to create a single predicate such that both input---   predicates should hold.--- makePairPredicate :: (IntervalAlgebraic (PairedInterval b) a) =>---        ComparativePredicateOf (Interval a)---     -> ComparativePredicateOf b---     -> ComparativePredicateOf (PairedInterval b a)--- makePairPredicate intervalPredicate dataPredicate x y =---          compareIntervals intervalPredicate x y &&---          dataPredicate (getPairData x) (getPairData y)

@@ -18,9 +18,10 @@ import IntervalAlgebra                    ( Interval                                           , Intervallic(..)                                           , IntervalCombinable(..)-                                          , IntervalAlgebraic(..)                                           , IntervalRelation (..)-                                          , beginerval, IntervalSizeable )+                                          , beginerval+                                          , IntervalSizeable+                                          , starts ) import IntervalAlgebra.IntervalUtilities  ( gaps                                           , durations                                           , intersect@@ -34,7 +35,7 @@                                           , foldMeetingSafe                                           , formMeetingSequence ) import IntervalAlgebra.PairedInterval     ( trivialize-                                          , mkPairedInterval+                                          , makePairedInterval                                           , PairedInterval, getPairData ) import Control.Monad                      ( liftM2 ) import Data.Foldable@@ -55,14 +56,14 @@    arbitrary =  State <$> suchThat (listOf arbitrary) (\x -> length x == 3)  instance Arbitrary (PairedInterval State Int) where-   arbitrary = liftM2 mkPairedInterval arbitrary arbitrary+   arbitrary = liftM2 makePairedInterval arbitrary arbitrary  instance Arbitrary (Events Int) where    arbitrary = Events <$> orderedList   -- Testing functions-checkSeqStates :: (IntervalAlgebraic i Int)=> [i Int] -> Bool+checkSeqStates :: (Intervallic i Int)=> [i Int] -> Bool checkSeqStates x = (length x > 1) || all (== Meets) (relations x)  -- Creation functions@@ -70,7 +71,7 @@ iv = beginerval  evpi :: Int -> Int -> [Bool] -> StateEvent Int-evpi i j s = mkPairedInterval (State s) (beginerval i j)+evpi i j s = makePairedInterval (State s) (beginerval i j)  -- Test cases containmentInt :: Interval Int@@ -92,14 +93,14 @@ meets2 = [iv 2 0, iv 2 2, iv 10 4, iv 2 14]  meets3 :: [PairedInterval Int Int]-meets3 = map (uncurry mkPairedInterval) [+meets3 = map (uncurry makePairedInterval) [       (5,  iv 2 0)     , (5,  iv 2 2)     , (9,  iv 10 4)     , (10, iv 2 14)]  meets3eq :: [PairedInterval Int Int]-meets3eq = map (uncurry mkPairedInterval) [+meets3eq = map (uncurry makePairedInterval) [       (5,  iv 4 0)     , (9,  iv 10 4)     , (10, iv 2 14)]@@ -159,7 +160,7 @@ -- Properties  -- Check that the only relation remaining after applying a function is Before-prop_before:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>+prop_before:: (Intervallic Interval a, IntervalCombinable Interval a)=>       ([Interval a] -> [Interval a])    -> [Interval a]    -> Property@@ -171,7 +172,7 @@    -> Property prop_combineIntervals1 = prop_before combineIntervals -prop_gaps1:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>+prop_gaps1:: (Intervallic Interval a, IntervalCombinable Interval a)=>      [Interval a]    -> Property prop_gaps1 = prop_before gaps

@@ -1,15 +1,16 @@ module IntervalAlgebra.PairedIntervalSpec (spec) where  import Test.Hspec                       ( it, describe, Spec, shouldBe )-import IntervalAlgebra.PairedInterval   ( PairedInterval, mkPairedInterval )+import IntervalAlgebra.PairedInterval   ( PairedInterval, makePairedInterval ) import IntervalAlgebra                  ( beginerval                                         , IntervalSizeable(duration)-                                        , IntervalAlgebraic(equals, before) )+                                        , equals+                                        , before )  type TestPair = PairedInterval String Int  mkTestPr :: String -> Int -> Int -> TestPair-mkTestPr x i j = mkPairedInterval x (beginerval i j)+mkTestPr x i j = makePairedInterval x (beginerval i j)  t1 :: TestPair t1 = mkTestPr "hi" 5 0

@@ -23,17 +23,27 @@                                   , expandl                                   , expand                                   , parseInterval+                                  , before+                                  , meets+                                  , overlaps+                                  , finishedBy+                                  , contains+                                  , starts+                                  , equals+                                  , startedBy+                                  , during+                                  , finishes+                                  , overlappedBy+                                  , metBy+                                  , after+                                  , relate+                                  , compose+                                  , disjoint+                                  , (<|>)                                   , IntervalCombinable((.+.))                                   , IntervalSizeable(moment, diff)-                                  , IntervalAlgebraic(  equals, starts-                                                      , finishes, finishedBy-                                                      , overlaps, during-                                                      , contains, compose-                                                      , relate, startedBy-                                                      , overlappedBy, disjoint-                                                      , before, after, meets-                                                      , metBy, (<|>))-                                  , ComparativePredicateOf+                                  , ComparativePredicateOf1+                                  , ComparativePredicateOf2                                   , Intervallic(begin, end)                                   , Interval ) @@ -93,7 +103,7 @@    \forall i,j,k,l s.t. (i:j & i:k & l:j) \implies l:k  \]  -}-prop_IAaxiomM1 :: (IntervalAlgebraic Interval a) => M1set a -> Property+prop_IAaxiomM1 :: (Intervallic Interval a) => M1set a -> Property prop_IAaxiomM1 x =   (i `meets` j && i `meets` k && l `meets` j) ==> (l `meets` k)   where i = m11 x@@ -157,7 +167,7 @@  \]  -} -prop_IAaxiomM2 :: (IntervalAlgebraic Interval a, IntervalSizeable a b) => M2set a -> Property+prop_IAaxiomM2 :: (Intervallic Interval a, IntervalSizeable a b) => M2set a -> Property prop_IAaxiomM2 x =   (i `meets` j && k `meets` l) ==>     (i `meets` l)  `xor`@@ -187,7 +197,7 @@  \]  -} -prop_IAaxiomML1 :: (IntervalAlgebraic Interval a) => Interval a -> Property+prop_IAaxiomML1 :: (Intervallic Interval a) => Interval a -> Property prop_IAaxiomML1 x = not (x `meets` x) === True  prop_IAaxiomML1_Int :: Interval Int -> Property@@ -207,7 +217,7 @@ \]  -} -prop_IAaxiomML2 :: (IntervalAlgebraic Interval a)=> M2set a -> Property+prop_IAaxiomML2 :: (Intervallic Interval a)=> M2set a -> Property prop_IAaxiomML2 x =   (i `meets` j) ==> not (j `meets` i)   where i = m21 x@@ -230,7 +240,7 @@ \]  -} -prop_IAaxiomM3 :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>+prop_IAaxiomM3 :: (Intervallic Interval a, IntervalSizeable a b)=>       b -> Interval a -> Property prop_IAaxiomM3 b i =    (j `meets` i && i `meets` k) === True@@ -254,7 +264,7 @@ \]  -} -prop_IAaxiomM4 :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>+prop_IAaxiomM4 :: (Intervallic Interval a, IntervalSizeable a b)=>      b -> M2set a -> Property prop_IAaxiomM4 b x =    ((m `meets` i && i `meets` j && j `meets` n) &&@@ -309,7 +319,7 @@         ps = end (expandr (makePos b) x) -- creating l by shifting and expanding i  -prop_IAaxiomM5 :: (IntervalAlgebraic Interval a, IntervalSizeable a b) => +prop_IAaxiomM5 :: (Intervallic Interval a, IntervalSizeable a b) =>      M5set a -> Property prop_IAaxiomM5 x =    ((i `meets` j && j `meets` l) &&@@ -358,7 +368,7 @@ * Interval Relation property testing  -} -class ( IntervalAlgebraic Interval a+class ( Intervallic Interval a       , IntervalCombinable Interval a       , IntervalSizeable a b       ) => IntervalRelationProperties a b where@@ -403,7 +413,7 @@  instance IntervalRelationProperties Int Int -allIArelations:: IntervalAlgebraic Interval a => [ComparativePredicateOf (Interval a)]+allIArelations:: Intervallic Interval a => [ComparativePredicateOf1 (Interval a)] allIArelations =   [  IA.equals                     , IA.meets                     , IA.metBy@@ -418,14 +428,14 @@                     , IA.during                     , IA.contains ] -prop_expandl_end ::(IntervalAlgebraic Interval a, IntervalSizeable a b)=>+prop_expandl_end ::(Intervallic Interval a, IntervalSizeable a b)=>        b     -> Interval a     -> Property prop_expandl_end d i = end (expandl d i) === end i  -prop_expandr_begin ::(IntervalAlgebraic Interval a, IntervalSizeable a b)=>+prop_expandr_begin ::(Intervallic Interval a, IntervalSizeable a b)=>        b     -> Interval a     -> Property@@ -433,7 +443,7 @@  -- | The relation between x and z should be an element of the set of the --   composed relations between x y and between y z.-prop_compose :: IntervalAlgebraic Interval a =>+prop_compose :: Intervallic Interval a =>        Interval a     -> Interval a     -> Interval a@@ -474,7 +484,7 @@       it "enderval -2 10 should be Interval (9, 10)" $         Right (enderval (-2::Int) 10) `shouldBe` parseInterval (9::Int) (10::Int) -  describe "IntervalAlgebraic tests" $+  describe "Intervallic tests" $      modifyMaxSuccess (*10000) $      do       it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 4) is True" $