interval-algebra 0.4.0 → 0.5.0

raw patch · 7 files changed

+424/−182 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• README.md +1/−2
• interval-algebra.cabal +1/−1
• src/IntervalAlgebra.hs +79/−92
• src/IntervalAlgebra/IntervalUtilities.hs +282/−56
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +38/−30
• test/IntervalAlgebraSpec.hs +14/−1

@@ -1,5 +1,14 @@ # Changelog for interval-algebra +## 0.5.0++* Adds the `compose` function to `IntervalAlgebraic` typeclass, thus now all the algebraic operations are available: complement, composition, converse, intersection, and union.+* In the `IntervalAlgebraic` typeclass, adds `concur` as a synonym for `notDisjoint`; `enclosedBy` as a synonym for `within`; and `enclose` as the converse of `enclosedBy`.+* Generalizes the utilities `combineIntervals`, `gaps`, `gapsWithin`, and `relations` to work with any `Applicative`, `Foldable` `Monoid` (of which `List` is a case).+* Changes the signature of `gapsWithin` to return `Maybe (f (Interval a))`, so that in the case that there are no gaps `Nothing` is returned.+* Renames the `emptyIf*` function to `nothingIf*`. Like `gapsWithin`, these now return `Maybe (f (Interval a))` so that `Nothing` is returned if the quantified predicated is true.+* Removes the `IntervalFilterable` typeclass and these functions are now available in the utilities module without needing to specify instances for each container type you want to filter.+ ## 0.4.0  * Adds utilities `emptyIfNone`, `emptyIfAny`, and `emptyIfAll` that apply predicates to a list of inputs. If none, any, or all of the inputs meet the predicate, then the empty list is returned. Otherwise, the input is returned unmodified. These functions are generalized to `Monoid`s, so they work on structures other than lists.

@@ -6,13 +6,12 @@  ## Design -The module is built around five typeclasses designed to separate concerns of constructing, relating, and combining `Interval`s:+The module is built around four typeclasses designed to separate concerns of constructing, relating, and combining `Interval`s:  1. `Intervallic` provides an interface to the data structure of an `Interval`, defining how an `Interval a` (simply a pair `(a, a)`) is constructed. 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 multiple `Interval`s. 4. `IntervalSizeable` and the related `Moment` provide methods for measuring and modifying the size of an interval.-5. `IntervalFilterable` provides methods for filtering 'Filterable' collections of intervals.  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. 

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           interval-algebra-version:        0.4.0+version:        0.5.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

@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE AllowAmbiguousTypes #-}  {-| Module      : Interval Algebra@@ -19,7 +20,7 @@  = Design -The module is built around five typeclasses designed to separate concerns of +The module is built around four typeclasses designed to separate concerns of  constructing, relating, and combining @'Interval'@s:   1. @'Intervallic'@ provides an interface to the data structure of an @'Interval'@, @@ -30,7 +31,6 @@    @'Interval's@. 4. @'IntervalSizeable'@ and the related @'Moment'@ provides methods for     measuring and modifying the size of an interval.-5. @'IntervalFilterable'@ provides methods for filtering 'Witherable.Filterable'     collections of intervals.  An advantage of nested typeclass design is that developers can define an @@ -47,10 +47,6 @@ This module is under development and the API may change in the future. -} --{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-} module IntervalAlgebra(      -- * Classes@@ -59,7 +55,6 @@     , IntervalCombinable(..)     , Moment(..)     , IntervalSizeable(..)-    , IntervalFilterable(..)      -- * Types     , Interval@@ -70,14 +65,13 @@ 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-               , (++), (==), (&&), (<), (>), (<=), ($), (+), (-), (.))+               , map, otherwise, flip, show, fst, snd, min, max, any, negate, not, replicate+               , (++), (==), (&&), (<), (>), (<=), ($), (+), (-), (.), (!!)) 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 GHC.Base (Applicative(pure))-import Witherable ( Filterable(filter) )  {- | An @'Interval' a@ is a pair of @a@s \( (x, y) \text{ where } x < y\). The @'Intervallic'@ class provides a safe @'parseInterval'@ function that returns a @@ -169,7 +163,7 @@     | Before     | After     | Overlaps-    | OverlappedBy +    | OverlappedBy     | Starts     | StartedBy     | Finishes@@ -225,6 +219,50 @@ converseRelation :: IntervalRelation a -> IntervalRelation a converseRelation x = toEnum (12 - fromEnum x) +-- | The lookup table for the compositions of interval relations.+composeRelationLookup :: [[[IntervalRelation a]]]+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]+      , [p    , p    , pmo  , pmo  , pmofd, o    , o , ofd  , osd  , osd  , cncr , dso  , dsomp]+      , [p    , m    , o    , f'   , d'   , o    , f', d'   , osd  , fef  , dso  , dso  , dsomp]+      , [pmofd, ofd  , ofd  , d'   , d'   , ofd  , d', d'   , cncr , dso  , dso  , dso  , dsomp]+      , [p    , p    , pmo  , pmo  , pmofd, s    , s , ses  , d    , d    , dfo  , m'   , p'   ]+      , [p    , m    , o    , f'   , d'   , s    , e , s'   , d    , f    , o'   , m'   , p'   ]+      , [pmofd, ofd  , ofd  , d'   , d'   , ses  , s', s'   , dfo  , o'   , o'   , m'   , p'   ]+      , [p    , p    , pmosd, pmosd, full , d    , d , dfomp, d    , d    , dfomp, p'   , p'   ]+      , [p    , m    , osd  , fef  , dsomp, d    , f , omp  , d    , f    , omp  , p'   , p'   ]+      , [pmofd, ofd  , cncr , dso  , dsomp, dfo  , o', omp  , dfo  , o'   , omp  , p'   , p'   ]+      , [pmofd, ses  , dfo  , m'   , p'   , dfo  , m', p'   , dfo  , m'   , p'   , p'   , p'   ]+      , [full , dfomp, dfomp, p'   , p'   , dfomp, p', p'   , dfomp, p'   , p'   , p'   , p'   ]+      ]+      where p  = [Before]+            m  = [Meets]+            o  = [Overlaps]+            f' = [FinishedBy]+            d' = [Contains]+            s  = [Starts]+            e  = [Equals]+            s' = [StartedBy]+            d  = [During]+            f  = [Finishes]+            o' = [OverlappedBy]+            m' = [MetBy]+            p' = [After]+            ses    = s ++ e ++ s'+            fef    = f' ++ e ++ f+            pmo    = p ++ m ++ o+            pmofd  = pmo ++ f' ++ d'+            osd    = o ++ s ++ d+            ofd    = o ++ f' ++ d'+            omp    = o' ++ m' ++ p'+            dfo    = d ++ f ++ o'+            dfomp  = dfo ++ m' ++ p'+            dso    = d' ++ s' ++ o'+            dsomp  = dso ++ m' ++ p'+            pmosd  = p ++ m ++ osd+            cncr = o ++ f' ++ d' ++ s ++ e ++ s' ++ d ++ f ++ o'+            full = p ++ m ++ cncr ++ m' ++ p' {- Misc -}@@ -285,7 +323,7 @@      -- | Maps an 'IntervalRelation' to its corresponding predicate function.     predicate' :: IntervalRelation a -> ComparativePredicateOf (Interval a)-    predicate' r = +    predicate' r =         case r of             Before       -> before             Meets        -> meets@@ -301,7 +339,7 @@             MetBy        -> metBy             After        -> after -    -- | Given a set of 'IntervalRelation's return a 'List' of 'predicate' functions +    -- | Given a set of 'IntervalRelation's return a list of 'predicate' functions      --   corresponding to each relation.     predicates :: Set (IntervalRelation a) -> [ComparativePredicateOf (Interval a)]     predicates x = Prelude.map predicate' (toList x)@@ -312,30 +350,35 @@      -- ** Algebraic operations on IntervalRelations -    -- | Shortcut to creating a 'Set IntervalRelation' from a 'List'.+    -- | Shortcut to creating a 'Set IntervalRelation' from a list.     toSet :: [IntervalRelation a] -> Set (IntervalRelation 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 a -> IntervalRelation a -> Set (IntervalRelation a)+    compose x y = toSet ((composeRelationLookup !! fromEnum x) !! fromEnum y)+     -- | Finds the complement of a 'Set IntervalRelation'.     complement :: Set (IntervalRelation a) -> Set (IntervalRelation a)     complement = difference intervalRelations      -- | Find the intersection of two 'Set's of 'IntervalRelation'-    intersection ::  Set (IntervalRelation a) +    intersection ::  Set (IntervalRelation a)                   -> Set (IntervalRelation a)                   -> Set (IntervalRelation a)     intersection = Data.Set.intersection      -- | Find the union of two 'Set's of 'IntervalRelation'-    union ::  Set (IntervalRelation a) +    union ::  Set (IntervalRelation a)            -> Set (IntervalRelation a)            -> Set (IntervalRelation a)-    union = Data.Set.union +    union = Data.Set.union      -- | Find the converse of a 'Set IntervalRelation'. -    converse ::   Set (IntervalRelation a) +    converse ::   Set (IntervalRelation a)                   -> Set (IntervalRelation a)-    converse = Data.Set.map converseRelation +    converse = Data.Set.map converseRelation      -- ** Interval algebra predicates @@ -362,7 +405,7 @@     starts, startedBy      :: ComparativePredicateOf (Interval a)     starts   x y  = begin x == begin y && (end x < end y)     startedBy     = flip starts-    +     -- | Synonyms for 'starts' and 'startedBy'     precedes, precededBy      :: ComparativePredicateOf (Interval a)     precedes      = starts@@ -392,13 +435,13 @@     (<|>) ::  ComparativePredicateOf (Interval a)         -> ComparativePredicateOf (Interval a)         -> ComparativePredicateOf (Interval a)-    (<|>) f g = unionPredicates [f, g]    +    (<|>) f g = unionPredicates [f, g]      disjointRelations :: Set (IntervalRelation a)     disjointRelations = toSet [Before, After, Meets, MetBy]      withinRelations :: Set (IntervalRelation a)-    withinRelations = toSet [During, Starts, Finishes, Equals]+    withinRelations = toSet [Starts, During, Finishes, Equals]      -- | Are x and y disjoint ('before', 'after', 'meets', or 'metBy')?     disjoint               :: ComparativePredicateOf (Interval a)@@ -408,12 +451,23 @@     notDisjoint            :: ComparativePredicateOf (Interval a)     notDisjoint = predicate (complement disjointRelations) -    -- | Is x wholly within y (including endpoints) in any sense 'during', +    -- | A synonym for 'notDisjoint'.+    concur                 :: ComparativePredicateOf (Interval a)+    concur = notDisjoint++    -- | Is x entirely *within* the endpoints of y? That is, 'during',      --   'starts', 'finishes', or 'equals'?-    within                    :: ComparativePredicateOf (Interval a)+    within                 :: ComparativePredicateOf (Interval a)     within = predicate withinRelations +    -- | Does x enclose y? That is, is y 'within' x?+    enclose                :: ComparativePredicateOf (Interval a)+    enclose = flip enclosedBy +    -- | Synonym for 'within'.+    enclosedBy             :: ComparativePredicateOf (Interval a)+    enclosedBy = within+ {- | The 'Moment' class fixes the smallest duration of an 'Intervallic a'. -}@@ -506,77 +560,13 @@     --   provided the intervals are not disjoint.     intersect :: Interval a -> Interval a -> Maybe (Interval a)     intersect x y-       | disjoint x y = Nothing +       | disjoint x y = Nothing        | otherwise    = Just $ Interval (b, e)            where b = max (begin x) (begin y)                  e = min (end x) (end y) -{- | -The @'IntervalFilterable'@ class provides functions for filtering 'Filterable's of -@'Interval'@s based on @'IntervalAlgebraic'@ relations.--}-class (Filterable f, IntervalAlgebraic a) => IntervalFilterable f a where -    -- |Creates a function for filtering a 'Witherable.Filterable' of @Interval a@s based on a predicate-    filterMaker :: ComparativePredicateOf (Interval a)-                   -> Interval a-                   -> (f (Interval a) -> f (Interval a))-    filterMaker f p = Witherable.filter (`f` p) -    -- | Filter a 'Witherable.Filterable' of @Interval a@s to those that 'overlaps' the @Interval a@-    --   in the first argument.-    filterOverlaps :: Interval a -> f (Interval a) -> f (Interval a)-    filterOverlaps = filterMaker overlaps--    -- | Filter a 'Witherable.Filterable' of @Interval a@s to those 'overlappedBy' the @Interval a@-    --   in the first argument.-    filterOverlappedBy :: Interval a -> f (Interval a) -> f (Interval a)-    filterOverlappedBy = filterMaker overlappedBy--    -- | Filter a 'Witherable.Filterable' of Interval as to those 'before' the @Interval a@-    --   in the first argument.-    filterBefore :: Interval a -> f (Interval a) -> f (Interval a)-    filterBefore = filterMaker before--    -- | Filter a 'Witherable.Filterable' of Interval as to those 'after' the @Interval a@-    --   in the first argument.-    filterAfter :: Interval a -> f (Interval a) -> f (Interval a)-    filterAfter = filterMaker after--    -- | Filter a 'Witherable.Filterable' of Interval as to those that 'meets' the @Interval a@-    --   in the first argument.-    filterMeets :: Interval a -> f (Interval a) -> f (Interval a)-    filterMeets = filterMaker meets--    -- | Filter a 'Witherable.Filterable' of Interval as to those 'metBy' the @Interval a@-    --   in the first argument.-    filterMetBy :: Interval a -> f (Interval a) -> f (Interval a)-    filterMetBy = filterMaker metBy--    -- | Filter a 'Witherable.Filterable' of Interval as to those 'during' the @Interval a@-    --   in the first argument.-    filterDuring :: Interval a -> f (Interval a) -> f (Interval a)-    filterDuring = filterMaker during--    -- | Filter a 'Witherable.Filterable' of Interval as to those that 'contains'-    --   the @Interval a@ in the first argument.-    filterContains :: Interval a -> f (Interval a) -> f (Interval a)-    filterContains = filterMaker contains--    -- | Filter a 'Witherable.Filterable' of Interval as to those that are 'disjoint'-    --   from the @Interval a@ in the first argument.-    filterDisjoint :: Interval a -> f (Interval a) -> f (Interval a)-    filterDisjoint = filterMaker disjoint--    -- | Filter a 'Witherable.Filterable' of Interval as to those that are 'notDisjoint'-    --   from the @Interval a@ in the first argument.-    filterNotDisjoint :: Interval a -> f (Interval a) -> f (Interval a)-    filterNotDisjoint = filterMaker notDisjoint--    -- | Filter a 'Witherable.Filterable' of Interval as to those that are 'within'-    --   the @Interval a@ in the first argument.-    filterWithin :: Interval a -> f (Interval a) -> f (Interval a)-    filterWithin = filterMaker disjoint {- Instances -}@@ -603,7 +593,6 @@ instance IntervalSizeable Int Int where     add = (+)     diff = (-)-instance IntervalFilterable [] Int  instance Intervallic Integer instance IntervalAlgebraic Integer@@ -612,7 +601,6 @@ instance IntervalSizeable Integer Integer where     add = (+)     diff = (-)-instance IntervalFilterable [] Integer  instance Intervallic DT.Day instance IntervalAlgebraic DT.Day@@ -621,4 +609,3 @@ instance IntervalSizeable DT.Day Integer where     add = addDays     diff = diffDays-instance IntervalFilterable [] DT.Day

@@ -9,43 +9,96 @@ Stability   : experimental -} -{-# LANGUAGE FlexibleContexts #-} module IntervalAlgebra.IntervalUtilities (       combineIntervals+    , combineIntervals'     , gaps+    , gaps'     , durations     , clip     , relations+    , relations'     , gapsWithin-    , emptyIf-    , emptyIfNone-    , emptyIfAny-    , emptyIfAll+    , nothingIf+    , nothingIfNone+    , nothingIfAny+    , nothingIfAll++    -- * Filtering functions+    , filterBefore+    , filterMeets+    , filterOverlaps+    , filterFinishedBy+    , filterContains+    , filterStarts+    , filterEquals+    , filterStartedBy+    , filterDuring+    , filterFinishes+    , filterOverlappedBy+    , filterMetBy+    , filterAfter+    , filterDisjoint+    , filterNotDisjoint+    , filterWithin+ ) where  import GHC.Base-    ( (++), map, foldr, otherwise, ($), (.), (<*>), seq, not-    , Semigroup((<>)), Functor(fmap), Maybe(..)+    ( otherwise, ($), (.), (<*>), seq, not+    , Semigroup((<>))+    , Functor(fmap)+    , Applicative(pure)     , Int, Bool) import GHC.Num ()-import Data.Tuple ( uncurry )-import Data.Foldable ( Foldable(null, foldl'), all, any )+import Data.Tuple ( fst )+import Data.Foldable ( Foldable(null, foldl', toList), all, any ) import Data.Monoid ( (<>), Monoid(mempty) ) import IntervalAlgebra     ( Interval, Intervallic(..), IntervalAlgebraic(..)     , IntervalCombinable(..), IntervalSizeable(..)-    , IntervalFilterable(..)-    , IntervalRelation(..))-import Data.Maybe (mapMaybe)-import Data.List ( (++), head, init, last, tail, zip )-import Witherable ( Filterable )+    , IntervalRelation(..)+    , ComparativePredicateOf)+import Data.Maybe (mapMaybe, catMaybes, fromMaybe, Maybe(..))+import Data.List ( (++), map, head, init, last, tail )+import Witherable ( Filterable(filter) ) +-------------------------------------------------+-- Unexported utilties used in functions below --+-------------------------------------------------+ intInt :: Int -> Int -> Interval Int intInt = unsafeInterval --- | Box to avoid overlapping instances--- TODO: avoid the head/tail footguns+-- Fold over consecutive pairs of foldable structure and collect the results in +-- a monoidal structure.+foldlAccume :: (Foldable f, Applicative m, Monoid (m a))=>+      (b -> b -> a) -- ^ @f@: a function to apply to consecutive elements of @f b@+    -> f b+    -> m a+foldlAccume f x = fst $ foldl' (applyAccume f) (mempty, Nothing) x++-- Apply a function and accumulate the results in a monoidal structure.+applyAccume :: (Monoid (f a), Applicative f) =>+       (b -> b -> a)  -- ^ @f@: a function combining two @b@s to get an @a@+    -> (f a, Maybe b) -- ^ a pair (accumulating monoid for @b@s, optional @a@)+    -> b              -- ^ this will be the second argument to @f@+    -> (f a, Maybe b)+applyAccume f (fs, Nothing) x = (fs, Just x)+applyAccume f (fs, Just x)  y  = (fs <> pure (f x y), Just y)++-- Lifts a list to a foldable, applicative monoid +liftListToFoldable :: (Applicative f+                      , Monoid (f a)+                      , Foldable f) =>+    [a] -> f a+liftListToFoldable = foldl' (\x y -> x <> pure y) mempty++-- Box to avoid overlapping instances newtype Box a = Box { unBox :: [a] }++-- Defines how a Box of Intervals are combined. Specifically, the last element of+-- x and first element of y are combined by '<+>'. instance (IntervalCombinable a) => Semigroup (Box (Interval a)) where     Box x <> Box y        | null x         = Box y@@ -54,28 +107,66 @@        where lx = last x              fy = head y +-------------------------------------------------++-- | Returns a container of intervals where any intervals that meet or share support+--   are combined into one interval. *To work properly, the input should +--   be sorted*. See 'combineIntervals'' for a version that works only on lists.+--+-- >>> combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]+-- [(0, 12),(13, 15)]+combineIntervals :: (IntervalCombinable a+         , Applicative f+         , Monoid (f (Interval a))+         , Foldable f) =>+      f (Interval a) ->+      f (Interval a)+combineIntervals x = liftListToFoldable (combineIntervals' $ toList x)+ -- | Returns a list of intervals where any intervals that meet or share support --   are combined into one interval. *To work properly, the input list should  --   be sorted*.  ----- >>> combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]+-- >>> combineIntervals' [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15] -- [(0, 12),(13, 15)]-combineIntervals :: (IntervalCombinable a) => [Interval a] -> [Interval a]-combineIntervals l = unBox $ foldl' (<>) (Box []) (map (\z -> Box [z]) l)+combineIntervals' :: (IntervalCombinable a) => [Interval a] -> [Interval a]+combineIntervals' l = unBox $ foldl' (<>) (Box []) (map (\z -> Box [z]) l) +-- | Returns a (possibly empty) container of intervals consisting of the gaps +--   between intervals in the input. *To work properly, the input should be+--   sorted*. See 'gaps'' for a version that returns a list.+--+-- >>> gaps [intInt 1 5, intInt 8 12, intInt 11 14]+-- [(5, 8)]+gaps :: (IntervalCombinable a+         , Applicative f+         , Monoid (f (Interval a))+         , Foldable f) =>+      f (Interval a) ->+      f (Interval a)+gaps x = liftListToFoldable (gaps' x)+ -- | Returns a (possibly empty) list of intervals consisting of the gaps between---   intervals in the input list. *To work properly, the input list should be sorted*.-gaps :: (IntervalCombinable a) => [Interval a] -> [Interval a]-gaps l = mapMaybe (uncurry (><)) ((zip <*> tail) l)+--   intervals in the input container. *To work properly, the input should be +--   sorted*. This version outputs a list. See 'gaps' for a version that lifts+--   the result to same input structure @f@.+gaps' :: (IntervalCombinable a+         , Applicative f+         , Monoid (f (Interval a))+         , Foldable f) =>+      f (Interval a) ->+      [Interval a]+gaps' x = catMaybes (foldlAccume (><) x)  -- | Returns the 'duration' of each 'Interval' in the 'Functor' @f@. -- -- >>> durations [intInt 1 10, intInt 2 12, intInt 5 6] -- [9,10,1]-durations :: (Functor f, IntervalSizeable a b) => f (Interval a) -> f b+durations :: (Functor f, IntervalSizeable a b)=>+       f (Interval a)+    -> f b durations = fmap duration - -- | In the case that x y are not disjoint, clips y to the extent of x. --  -- >>> clip (intInt 0 5) (intInt 3 6)@@ -96,37 +187,64 @@    where jy = equals <|> startedBy <|> contains <|> finishedBy          jx = starts <|> during <|> finishes --- | Finds the 'IntervalRelation' between each consecutive pair of intervals.--- +-- | Returns a list of the 'IntervalRelation' between each consecutive pair +--   of intervals. This the specialized form of 'relations'' which can return+--   any 'Applicative', 'Monoid' structure.+-- -- >>> relations [intInt 0 1, intInt 1 2]  -- [Meets]-relations :: (IntervalAlgebraic a)=> [Interval a] -> [IntervalRelation a]--- TODO: generalize to collections besides list-relations x = map (uncurry relate) ((zip <*> tail) x)+relations :: (IntervalAlgebraic a, Foldable f)=>+       f (Interval a)+    -> [IntervalRelation a]+relations = relations' +-- | A generic form of 'relations' which can output any 'Applicative' and +--   'Monoid' structure. +-- >>> (relations' [intInt 0 1, intInt 1 2]) :: [IntervalRelation Int]+-- [Meets]+relations' :: ( IntervalAlgebraic a+              , Foldable f+              , Applicative m+              , Monoid (m (IntervalRelation a)) )=>+        f (Interval a)+     -> m (IntervalRelation a)+relations' = foldlAccume relate+ -- | Applies 'gaps' to all the non-disjoint intervals in @x@ that are *not* disjoint--- from @i@. Intervals that 'overlaps' or are 'overlappedBy' @i@ are 'clip'ped to @i@.+-- from @i@. Intervals that 'overlaps' or are 'overlappedBy' @i@ are 'clip'ped +-- to @i@, so that all the intervals are 'within' @i@. If there are no gaps, then+-- 'Nothing' is returned. -- -- >>> gapsWithin (intInt 1 10) [intInt 0 5, intInt 7 9, intInt 12 15]--- [(5, 7),(9, 10)]-gapsWithin :: (IntervalSizeable a b, IntervalCombinable a, IntervalFilterable [] a)=>-      Interval a  -- ^ i-  -> [Interval a] -- ^ x-  -> [Interval a]--- TODO: generalize to collections besides list-gapsWithin i x = gaps $ enderval 0 (begin i) :-                        mapMaybe (clip i) (filterNotDisjoint i x) ++-                        [beginerval 0 (end i)]+-- Just [(5, 7),(9, 10)]+--+gapsWithin :: ( Applicative f+               , Foldable f+               , Monoid (f (Interval a))+               , IntervalSizeable a b+               , IntervalCombinable a+               , Filterable f+               , IntervalAlgebraic a)=>+     Interval a     -- ^ i+  -> f (Interval a) -- ^ x+  -> Maybe (f (Interval a))+gapsWithin i x +  | null ivs  = Nothing  +  | otherwise = Just $ gaps $ pure s <> ivs <> pure e+        where s   = enderval   0 (begin i)+              e   = beginerval 0 (end i)+              nd  = toList (filterNotDisjoint i x)+              ivs = liftListToFoldable (mapMaybe (clip i) nd)   -- | Given a predicate combinator, a predicate, and list of intervals, returns ---   the input unchanged if the predicate combinator is 'True'. Otherwise, returns+--   the input unchanged if the predicate combinator is @True@. Otherwise, returns --   an empty list. See 'emptyIfAny' and 'emptyIfNone' for examples.-emptyIf :: (Monoid (f (Interval a)), Foldable f, IntervalFilterable f a)=>+nothingIf :: (Monoid (f (Interval a)), Filterable f, IntervalAlgebraic a)=>      ((Interval a -> Bool) -> f (Interval a) -> Bool) -- ^ e.g. 'any' or 'all'   -> (Interval a -> Bool) -- ^ predicate to apply to each element of input list   -> f (Interval a)-  -> f (Interval a)-emptyIf g f x = if g f x then mempty else x+  -> Maybe (f (Interval a))+nothingIf quantifier predicate x = if quantifier predicate x then Nothing else Just x  -- | Returns the empty monoid structure if *none* of the element of input satisfy --   the predicate condition.@@ -134,31 +252,139 @@ -- For example, the following returns the empty list because none of the intervals -- in the input list 'starts' (3, 5). ----- >>> emptyIfNone (starts (intInt 3 5)) [intInt 3 4, intInt 5 6]--- []+-- >>> nothingIfNone (starts (intInt 3 5)) [intInt 3 4, intInt 5 6] -- -- In the following, (3, 5) 'starts' (3, 6), so the input is returned. ----- >>> emptyIfNone (starts (intInt 3 5)) [intInt 3 6, intInt 5 6]--- [(3, 6),(5, 6)]-emptyIfNone :: (Monoid (f (Interval a)), Foldable f, IntervalFilterable f a)=>+-- >>> nothingIfNone (starts (intInt 3 5)) [intInt 3 6, intInt 5 6]+--+nothingIfNone :: (Monoid (f (Interval a)), Foldable f, Filterable f, IntervalAlgebraic a)=>     (Interval a -> Bool) -- ^ predicate to apply to each element of input list   -> f (Interval a)-  -> f (Interval a)-emptyIfNone = emptyIf (\f x -> (not.any f) x)+  -> Maybe (f (Interval a))+nothingIfNone = nothingIf (\f x -> (not.any f) x)  -- | Returns the empty monoid structure if *any* of the element of input satisfy --   the predicate condition-emptyIfAny :: (Monoid (f (Interval a)), Foldable f, IntervalFilterable f a)=>+nothingIfAny :: (Monoid (f (Interval a)), Foldable f, Filterable f, IntervalAlgebraic a)=>     (Interval a -> Bool) -- ^ predicate to apply to each element of input list   -> f (Interval a)-  -> f (Interval a)-emptyIfAny = emptyIf any+  -> Maybe (f (Interval a))+nothingIfAny = nothingIf any  -- | Returns the empty monoid structure if *all* of the element of input satisfy --   the predicate condition-emptyIfAll :: (Monoid (f (Interval a)), Foldable f, IntervalFilterable f a)=>+nothingIfAll :: (Monoid (f (Interval a)), Foldable f, Filterable f, IntervalAlgebraic a)=>     (Interval a -> Bool) -- ^ predicate to apply to each element of input list   -> f (Interval a)-  -> f (Interval a)-emptyIfAll = emptyIf all+  -> Maybe (f (Interval a))+nothingIfAll = nothingIf all+++{- | +Filter functions provides means for filtering 'Filterable' containers of +@'Interval'@s based on @'IntervalAlgebraic'@ relations.+-}++-- |Creates a function for filtering a 'Witherable.Filterable' of @Interval a@s based on a predicate+filterMaker :: (Filterable f, IntervalAlgebraic a) =>+                 ComparativePredicateOf (Interval a)+                -> Interval a+                -> (f (Interval a) -> f (Interval a))+filterMaker f p = Witherable.filter (`f` p)++-- | Filter a 'Witherable.Filterable' of @Interval a@s to those that 'overlaps' the @Interval a@+--   in the first argument.+filterOverlaps :: (Filterable f, IntervalAlgebraic a) => +                  Interval a -> f (Interval a) -> f (Interval a)+filterOverlaps = filterMaker overlaps++-- | Filter a 'Witherable.Filterable' of @Interval a@s to those 'overlappedBy' the @Interval a@+--   in the first argument.+filterOverlappedBy :: (Filterable f, IntervalAlgebraic a) => +                      Interval a -> f (Interval a) -> f (Interval a)+filterOverlappedBy = filterMaker overlappedBy++-- | Filter a 'Witherable.Filterable' of Interval as to those 'before' the @Interval a@+--   in the first argument.+filterBefore :: (Filterable f, IntervalAlgebraic a) => +                Interval a -> f (Interval a) -> f (Interval a)+filterBefore = filterMaker before++-- | Filter a 'Witherable.Filterable' of Interval as to those 'after' the @Interval a@+--   in the first argument.+filterAfter :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterAfter = filterMaker after++-- | Filter a 'Witherable.Filterable' of Interval as to those 'starts' the @Interval a@+--   in the first argument.+filterStarts :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterStarts = filterMaker starts ++-- | Filter a 'Witherable.Filterable' of Interval as to those 'startedBy' the @Interval a@+--   in the first argument.+filterStartedBy :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterStartedBy = filterMaker startedBy ++-- | Filter a 'Witherable.Filterable' of Interval as to those 'finishes' the @Interval a@+--   in the first argument.+filterFinishes :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterFinishes = filterMaker finishes++-- | Filter a 'Witherable.Filterable' of Interval as to those 'finishedBy' the @Interval a@+--   in the first argument.+filterFinishedBy :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterFinishedBy = filterMaker finishedBy ++-- | Filter a 'Witherable.Filterable' of Interval as to those that 'meets' the @Interval a@+--   in the first argument.+filterMeets :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterMeets = filterMaker meets++-- | Filter a 'Witherable.Filterable' of Interval as to those 'metBy' the @Interval a@+--   in the first argument.+filterMetBy :: (Filterable f, IntervalAlgebraic a) => +               Interval a -> f (Interval a) -> f (Interval a)+filterMetBy = filterMaker metBy++-- | Filter a 'Witherable.Filterable' of Interval as to those 'during' the @Interval a@+--   in the first argument.+filterDuring :: (Filterable f, IntervalAlgebraic a) => +                Interval a -> f (Interval a) -> f (Interval a)+filterDuring = filterMaker during++-- | Filter a 'Witherable.Filterable' of Interval as to those that 'contains'+--   the @Interval a@ in the first argument.+filterContains :: (Filterable f, IntervalAlgebraic a) => +                  Interval a -> f (Interval a) -> f (Interval a)+filterContains = filterMaker contains++-- | Filter a 'Witherable.Filterable' of Interval as to those that 'equals'+--   the @Interval a@ in the first argument.+filterEquals :: (Filterable f, IntervalAlgebraic a) => +                  Interval a -> f (Interval a) -> f (Interval a)+filterEquals = filterMaker equals++-- | Filter a 'Witherable.Filterable' of Interval as to those that are 'disjoint'+--   from the @Interval a@ in the first argument.+filterDisjoint :: (Filterable f, IntervalAlgebraic a) => +                  Interval a -> f (Interval a) -> f (Interval a)+filterDisjoint = filterMaker disjoint++-- | Filter a 'Witherable.Filterable' of Interval as to those that are 'notDisjoint'+--   from the @Interval a@ in the first argument.+filterNotDisjoint :: (Filterable f, IntervalAlgebraic a) => +                     Interval a -> f (Interval a) -> f (Interval a)+filterNotDisjoint = filterMaker notDisjoint++-- | Filter a 'Witherable.Filterable' of Interval as to those that are 'within'+--   the @Interval a@ in the first argument.+filterWithin :: (Filterable f, IntervalAlgebraic a) => +                Interval a -> f (Interval a) -> f (Interval a)+filterWithin = filterMaker disjoint

@@ -7,6 +7,7 @@                         , IntervalRelation (..) ) import IntervalAlgebra.Arbitrary () import IntervalAlgebra.IntervalUtilities+import Test.Hspec.QuickCheck ( modifyMaxSuccess ) import Test.Hspec ( it, shouldBe, describe, Spec, pending ) import Test.QuickCheck import Data.List(sort)@@ -27,90 +28,97 @@ gapInt = unsafeInterval (10 :: Int) (15 :: Int)  prop_combineIntervals1:: (IntervalAlgebraic a, IntervalCombinable a)=>-     [Interval a] +     [Interval a]    -> Property-prop_combineIntervals1 x = -   (length x > 2) ==> relations ci == replicate (length ci - 1) Before+prop_combineIntervals1 x = relations ci === replicate (length ci - 1) Before       where ci = combineIntervals (sort x)  prop_gaps1:: (IntervalAlgebraic a, IntervalCombinable a)=>-     [Interval a] +     [Interval a]    -> Property-prop_gaps1 x = -   (length x > 2) ==> relations gs == replicate (length gs - 1) Before+prop_gaps1 x = relations gs === replicate (length gs - 1) Before       where gs = gaps (sort x)   spec :: Spec spec = do    describe "combineIntervals unit tests" $+    modifyMaxSuccess (*10) $     do       it "noncontainmentInt combined into containmentInt" $-         combineIntervals [containmentInt, noncontainmentInt] +         combineIntervals [containmentInt, noncontainmentInt]             `shouldBe` [containmentInt]       it "noncontainmentInt combined into containmentInt; anotherInt unchanged" $-         combineIntervals [containmentInt, noncontainmentInt, anotherInt] +         combineIntervals [containmentInt, noncontainmentInt, anotherInt]             `shouldBe` [containmentInt, anotherInt]       it "idempotency of containmentInt" $          combineIntervals [containmentInt] `shouldBe` [containmentInt]       it "idempotency of noncontainmentInt" $          combineIntervals [noncontainmentInt] `shouldBe` [noncontainmentInt]+      it "combineIntervals [] should be []" $+         combineIntervals ([] :: [Interval Int]) `shouldBe` []       it "combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]" $-         combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15] +         combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]             `shouldBe` [intInt 0 12, intInt 13 15]-      it "after combining, only relation should be Before" $ -         property (prop_combineIntervals1 @Int) +      it "after combining, only relation should be Before" $+         property (prop_combineIntervals1 @Int) -       describe "gaps tests" $-    do +    modifyMaxSuccess (*10) $+    do       it "no gaps in containmentInt and noncontainmentInt" $          gaps [containmentInt, noncontainmentInt] `shouldBe` []       it "no gaps in containmentInt" $          gaps [containmentInt] `shouldBe` []       it "single gap between containmentInt and anotherInt" $          gaps [containmentInt, anotherInt] `shouldBe` [gapInt]-      it "after gaps, only relation should be Before" $ -         property (prop_gaps1 @Int) -  +      it "after gaps, only relation should be Before" $+         property (prop_gaps1 @Int)+    describe "durations unit tests" $-      do +      do          it "durations of containmentInt is 10" $             durations [containmentInt] `shouldBe` [10]-         -- it "durations of empty list is empty list" $-         --    durations [] `shouldBe` []+         it "durations of empty list is empty list" $+            durations  ([] :: [Interval Int])  `shouldBe` []          it "durations of [containmentInt, anotherInt] is [10, 5]" $             durations [containmentInt, anotherInt] `shouldBe` [10, 5]     describe "clip tests" $-      do +      do          it "clip disjoint should be Nothing" $            clip containmentInt gapInt `shouldBe` Nothing          it "clip Interval (4, 10) Interval (0, 10) should be Interval (4, 10)" $-           clip noncontainmentInt containmentInt `shouldBe` +           clip noncontainmentInt containmentInt `shouldBe`              Just (unsafeInterval 4 10)          it "clip x y === intersect sort x y " pending     describe "relations tests" $-      do +      do          it "relations [(0, 10), (4, 10), (10, 15), (15, 20)] == [FinishedBy, Meets, Meets]" $             relations [containmentInt, noncontainmentInt, gapInt, anotherInt] `shouldBe`                [FinishedBy, Meets, Meets]+         it "relations of [] shouldBe []" $+            relations ([] :: [Interval Int]) `shouldBe` []+         it "relations of singleton shouldBe []" $+            relations [containmentInt] `shouldBe` []          it "more relations tests" pending     describe "gapsWithin tests" $-      do +      do          it "gapsWithin (1, 10) [(0,5), (7,9), (12,15)] should be [(5,7), (9,10)]" $-            gapsWithin (intInt 1 10) [intInt 0 5, intInt 7 9, intInt 12 15] -               `shouldBe` [intInt 5 7, intInt 9 10]+            gapsWithin (intInt 1 10) [intInt 0 5, intInt 7 9, intInt 12 15]+               `shouldBe` Just [intInt 5 7, intInt 9 10]+         it "gapsWithin (1, 10) [] should be []" $+             gapsWithin (intInt 1 10) [] `shouldBe` Nothing          it "more gapsWithin tests" pending     describe "emptyIf tests" $-      do +      do          it "emptyIfNone (starts (3, 5)) [(3,4), (5,6)] should be empty" $-            emptyIfNone (starts (intInt 3 5)) [intInt 3 4, intInt 5 6] -               `shouldBe` []+            nothingIfNone (starts (intInt 3 5)) [intInt 3 4, intInt 5 6]+               `shouldBe` Nothing          it "emptyIfNone (starts (3, 5)) [(3,6), (5,6)] shoiuld be input" $-            emptyIfNone (starts (intInt 3 5)) [intInt 3 6, intInt 5 6] -               `shouldBe` [ intInt 3 6, intInt 5 6]+            nothingIfNone (starts (intInt 3 5)) [intInt 3 6, intInt 5 6]+               `shouldBe` Just [ intInt 3 6, intInt 5 6]          it "more emptyif tests" pending

@@ -13,6 +13,7 @@ import Control.Monad () import IntervalAlgebra.Arbitrary () import Data.Time as DT ( Day )+import Data.Set (member)  mkIntrvl = unsafeInterval @@ -411,6 +412,16 @@     -> Property prop_expandr_begin d i = begin (expandr d i) === begin i +-- | 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 a =>+       Interval a+    -> Interval a+    -> Interval a+    -> Property +prop_compose x y z = member (relate x z) (compose (relate x y) (relate y z)) === True++ spec :: Spec spec = do   describe "IntervalSizeable tests" $@@ -445,6 +456,7 @@         enderval (-2::Int) 10 `shouldBe` unsafeInterval (9::Int) (10::Int)    describe "IntervalAlgebraic tests" $+     modifyMaxSuccess (*10000) $      do       it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 4) is True" $         (startedBy <|> overlappedBy) (mkIntrvl (0::Int) (9::Int)) (mkIntrvl (-1::Int) (4::Int))@@ -455,10 +467,11 @@       it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 9) is False" $         (startedBy <|> overlappedBy) (mkIntrvl (0::Int) (9::Int)) (mkIntrvl (-1::Int) (9::Int))          `shouldBe` False-       it "disjoint x y same as explicit union of predicates" $          disjoint (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (3::Int) (5::Int)) `shouldBe`          (before <|> after <|> meets <|> metBy) (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (3::Int) (5::Int))+      it "prop_compose holds" $+         property (prop_compose @Int)    describe "IntervalCombinable tests" $     do