interval-algebra 2.0.2 → 2.1.0

raw patch · 13 files changed

+2016/−485 lines, 13 filesdep ~timenew-component:exe:tutorialPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• ChangeLog.md +18/−1
• interval-algebra.cabal +28/−16
• src/IntervalAlgebra/Arbitrary.hs +1/−1
• src/IntervalAlgebra/Core.hs +721/−278
• src/IntervalAlgebra/IntervalDiagram.hs +116/−43
• src/IntervalAlgebra/IntervalUtilities.hs +278/−114
• src/IntervalAlgebra/PairedInterval.hs +2/−8
• src/IntervalAlgebra/RelationProperties.hs +2/−2
• test-relation-properties/RelationPropertiesSpec.hs +3/−3
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +13/−6
• test/IntervalAlgebra/PairedIntervalSpec.hs +5/−9
• test/IntervalAlgebraSpec.hs +6/−4
• tutorial/TutorialMain.hs +823/−0

@@ -1,5 +1,22 @@ # Changelog for interval-algebra +## 2.1.0++* Changes the type signature of the `Intervallic` typeclass.+* Adds a package component `tutorial` used to provide data for a tutorial document.+* Adds a tutorial document: _interval-algebra foundations_.+* Adds a function `standardExampleDiagram` to `IntervalAlgebra.IntervalDiagram` that can be concisely invoked in Haddock documentation examples.+* Renames `enclose` to `encloses` so tense is consistent with other relational predicates.+* Changes `combineIntervals` and `combineIntervalsL` to sort their inputs and adds new functions `combineIntervalsFromSorted` and `combineIntervalsFromSortedL` for cases when the input data already are sorted.+* Removes the unnecessary `Ord` constraint from `begin` and `end`, made possible by the changes to `Intervallic`.+* Removes `Functor Interval` instance and the `Functor`, `Bifunctor` instances of `PairedInterval`. It is not possible to write an instance that both satisfies the `Functor` laws and maintains the desired `Interval` property that the `begin` be strictly less than the `end`.+* Minor changes to the `IntervalAlgebra.IntervalDiagram` module, such as re-exporting `Pretty` and its methods.+* Deprecates `(<+>)`.++## 2.0.3++* Adds `labeledIntervalDiagram`, which creates interval diagrams with labels and a `rangeInterval` reference interval.+ ## 2.0.2  * Adds `rangeInterval`, which creates the smallest inverval containing all intervals in a `Foldable`.@@ -14,7 +31,7 @@  * Adds `Abitrary (Interval a)` instance generic over `Ord a, Arbitrary a`. * Removes the `moment'` function from the `IntervalSizeable` class.-Use type application with `moment` instead, as in `moment @Int`, `moment @Day`, etc.+* Use type application with `moment` instead, as in `moment @Int`, `moment @Day`, etc. * Adds the following utility functions: `lookback`, `lookahead`, `makeGapsWithinPredicate`, `pairGaps`, `anyGapsWithinAtLeastDuration`, `allGapsWithinLessThanDuration`

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           interval-algebra-version:        2.0.2+version:        2.1.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@@ -32,7 +32,7 @@       IntervalAlgebra.Arbitrary   other-modules:       Paths_interval_algebra-  autogen-modules: +  autogen-modules:       Paths_interval_algebra   hs-source-dirs:       src@@ -53,46 +53,46 @@   default-language: Haskell2010  test-suite axioms-  type: exitcode-stdio-1.0  -  main-is: Main.hs -  other-modules: +  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:       AxiomsSpec   hs-source-dirs:       test-axioms   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5-    , hspec +    , hspec     , interval-algebra     , QuickCheck     , time   default-language: Haskell2010  test-suite relations-  type: exitcode-stdio-1.0  -  main-is: Main.hs -  other-modules: +  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:       RelationPropertiesSpec   hs-source-dirs:       test-relation-properties   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5-    , hspec +    , hspec     , interval-algebra-    , QuickCheck -    , time +    , QuickCheck+    , time   default-language: Haskell2010  test-suite interval-algebra-test-  type: exitcode-stdio-1.0  -  main-is: Spec.hs +  type: exitcode-stdio-1.0+  main-is: Spec.hs   other-modules:       IntervalAlgebraSpec       IntervalAlgebra.IntervalUtilitiesSpec       IntervalAlgebra.PairedIntervalSpec       Paths_interval_algebra-  autogen-modules: +  autogen-modules:       Paths_interval_algebra   hs-source-dirs:       test@@ -100,7 +100,7 @@   build-depends:       base >=4.7 && <5     , containers-    , hspec +    , hspec     , interval-algebra     , QuickCheck     , safe@@ -108,4 +108,16 @@     , witherable   build-tool-depends:       hspec-discover:hspec-discover >= 2.9.2+  default-language: Haskell2010++executable tutorial+  main-is: TutorialMain.hs+  hs-source-dirs: tutorial+  build-depends:+      base >=4.7 && <5+    , containers ^>= 0.6+    , interval-algebra+    , prettyprinter ^>= 1.7+    , time ^>= 1.9+    , witch ^>= 1.0   default-language: Haskell2010

@@ -120,7 +120,7 @@ -- arbitraryWithRelation   :: forall i a b-   . (IntervalSizeable a b, Intervallic i a, Arbitrary (i a))+   . (IntervalSizeable a b, Intervallic i, Arbitrary (i a))   => i a -- ^ reference interval   -> Data.Set.Set IntervalRelation -- ^ set of `IntervalRelation`s, of which at least one will hold for the generated interval relative to the reference   -> Gen (Maybe (i a))

@@ -5,15 +5,15 @@ License     : BSD3 Maintainer  : bsaul@novisci.com -The @IntervalAlgebra@ module provides data types and related classes for the +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). +and axiomatized in [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x). A good primer on Allen's algebra can be [found here](https://thomasalspaugh.org/pub/fnd/allen.html).  = Design -The module is built around three typeclasses designed to separate concerns of -constructing, relating, and combining types that contain @'Interval'@s: +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'@.@@ -53,111 +53,27 @@   , safeInterval   , si -    -- ** Modify intervals  +    -- ** Modify intervals   , expand   , expandl   , expandr -    -- * Interval Algebra +    -- * Interval Algebra      -- ** Interval Relations and Predicates   , IntervalRelation(..)--    {- |-    === Meets, Metby--    > x `meets` y-    > y `metBy` x--    @ -    x: |-----|-    y:       |-----| -    @-    -}   , meets   , metBy--    {- |-    === Before, After--    > x `before` y-    > y `after` x--    @ -    x: |-----|  -    y:          |-----|-    @-    -}   , before   , after--    {- |-    === Overlaps, OverlappedBy--    > x `overlaps` y-    > y `overlappedBy` x--    @ -    x: |-----|-    y:     |-----|-    @-    -}   , overlaps   , overlappedBy--    {- |-    === Finishes, FinishedBy--    > x `finishes` y-    > y `finishedBy` x--    @ -    x:   |---| -    y: |-----|-    @-    -}   , finishedBy   , finishes--    {- |-    === During, Contains--    > x `during` y-    > y `contains` x--    @ -    x:   |-| -    y: |-----|-    @-    -}   , contains   , during--    {- |-    === Starts, StartedBy--    > x `starts` y-    > y `startedBy` x--    @ -    x: |---| -    y: |-----|-    @-    -}   , starts   , startedBy--    {- |-    === Equal--    > x `equal` y-    > y `equal` x--    @ -    x: |-----| -    y: |-----|-    @-    -}   , equals      -- ** Additional predicates and utilities@@ -167,7 +83,7 @@   , notDisjoint   , concur   , within-  , enclose+  , encloses   , enclosedBy   , (<|>)   , predicate@@ -184,6 +100,8 @@   , shiftFromBegin   , shiftFromEnd   , momentize+  , toEnumInterval+  , fromEnumInterval      -- ** Algebraic operations   , intervalRelations@@ -213,7 +131,6 @@                                                 , flip                                                 , id                                                 )-import           Data.Functor                   ( Functor(fmap) ) import           Data.Ord                       ( Ord(..)                                                 , Ordering(..)                                                 , max@@ -282,6 +199,10 @@                                                 , suchThat                                                 ) +{- $setup+>>> import IntervalAlgebra.IntervalDiagram+-}+ {- | An @'Interval' a@ is a pair \( (x, y) \text{ such that } x < y\). To create intervals use the @'parseInterval'@, @'beginerval'@, or @'enderval'@ functions. -}@@ -291,19 +212,20 @@ newtype ParseErrorInterval = ParseErrorInterval String     deriving (Eq, Show) --- | Helper defining what a valid relation is between begin and end of an--- Interval.+{- | Helper defining what a valid relation is between begin and end of an+Interval.+-} isValidBeginEnd :: (Ord a) => a -> a -> Bool isValidBeginEnd b e = b < e --- | Safely parse a pair of @a@s to create an @'Interval' a@.------ >>> parseInterval 0 1--- Right (0, 1)--- --- >>> parseInterval 1 0--- Left (ParseErrorInterval "0<=1")--- +{- | Safely parse a pair of @a@s to create an @'Interval' a@.++>>> parseInterval 0 1+Right (0, 1)++>>> parseInterval 1 0+Left (ParseErrorInterval "0<=1")+-} parseInterval   :: (Show a, Ord a) => a -> a -> Either ParseErrorInterval (Interval a) parseInterval x y@@ -313,25 +235,21 @@ prsi :: (Show a, Ord a) => a -> a -> Either ParseErrorInterval (Interval a) prsi = parseInterval -intervalBegin :: (Ord a) => Interval a -> a+intervalBegin :: Interval a -> a intervalBegin (Interval x) = fst x -intervalEnd :: (Ord a) => Interval a -> a+intervalEnd :: Interval a -> a intervalEnd (Interval x) = snd x -instance Functor Interval where-  fmap f (Interval (x, y)) = Interval (f x, f y)- instance (Show a, Ord a) => Show (Interval a) where   show x = "(" ++ show (begin x) ++ ", " ++ show (end x) ++ ")"  instance Binary a => Binary (Interval a) instance NFData a => NFData (Interval a) -{- | -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'@. +{- | 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)@@ -342,23 +260,29 @@ >>> end (Interval (0, 10)) 10 -}-class (Ord a) => Intervallic i a where+class Intervallic i 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+    setInterval :: i a -> Interval b -> i b  -- | Access the endpoints of an @i a@ .-begin, end :: Intervallic i a => i a -> a+begin, end :: (Intervallic i) => i a -> a begin = intervalBegin . getInterval end = intervalEnd . getInterval -{- | -The 'IntervalRelation' type and the associated predicate functions enumerate+{- | This *unexported* function is an internal convenience function for cases in+which @f@ is known to be strictly monotone.+-}+imapStrictMonotone :: (Intervallic i) => (a -> b) -> i a -> i b+imapStrictMonotone f i = setInterval i (op f (getInterval i))+  where op f (Interval (b, e)) = Interval (f b, f e)++{- | 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 +to Allen's interval algebra. Constructors are shown with their corresponding predicate function. -} data IntervalRelation =@@ -384,58 +308,236 @@ instance Ord IntervalRelation where   compare x y = compare (fromEnum x) (fromEnum y) --- | Does x `meets` y? Is x metBy y?++{- | Does x `meets` y? Is x `metBy` y?++Example data with corresponding diagram:++>>> x = bi 5 0+>>> y = bi 5 5+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+-----      <- [x]+     ----- <- [y]+==========++Examples:++>>> x `meets` y+True++>>> x `metBy` y+False++>>> y `meets` x+False++>>> y `metBy` x+True+-} meets, metBy-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Eq a, Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a) meets x y = end x == begin y metBy = flip meets --- | Is x before y? Is x after y?++{- | Is x `before` y? Does x `precedes` y? Is x `after` y? Is x `precededBy` y?++Example data with corresponding diagram:++>>> x = bi 3 0+>>> y = bi 4 6+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+---        <- [x]+      ---- <- [y]+==========++Examples:++>>> x `before` y+True+>>> x `precedes` y+True++>>> x `after`y+False+>>> x `precededBy` y+False++>>> y `before` x+False+>>> y `precedes` x+False++>>> y `after` x+True+>>> y `precededBy` x+True+-} before, after, precedes, precededBy-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a) before x y = end x < begin y after = flip before precedes = before precededBy = after--- | Does x overlap y? Is x overlapped by y?+++{- | Does x `overlaps` y? Is x `overlappedBy` y?++Example data with corresponding diagram:++>>> x = bi 6 0+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+------     <- [x]+    ------ <- [y]+==========++Examples:++>>> x `overlaps` y+True++>>> x `overlappedBy` y+False++>>> y `overlaps` x+False++>>> y `overlappedBy` x+True+-} overlaps, overlappedBy-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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?++{-| Does x `starts` y? Is x `startedBy` y?++Example data with corresponding diagram:++>>> x = bi 3 4+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ---    <- [x]+    ------ <- [y]+==========++Examples:++>>> x `starts` y+True++>>> x `startedBy` y+False++>>> y `starts` x+False++>>> y `startedBy` x+True+-} starts, startedBy-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a) starts x y = begin x == begin y && end x < end y startedBy = flip starts --- | Does x finish y? Is x finished by y?++{- | Does x `finishes` y? Is x `finishedBy` y?++Example data with corresponding diagram:++>>> x = bi 3 7+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+       --- <- [x]+    ------ <- [y]+==========++Examples:++>>> x `finishes` y+True++>>> x `finishedBy` y+False++>>> y `finishes` x+False++>>> y `finishedBy` x+True+-} finishes, finishedBy-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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?++{-| Is x `during` y? Does x `contains` y?++Example data with corresponding diagram:++>>> x = bi 3 5+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+     ---   <- [x]+    ------ <- [y]+==========++Examples:++>>> x `during` y+True++>>> x `contains` y+False++>>> y `during` x+False++>>> y `contains` x+True+-} during, contains-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a) during x y = begin x > begin y && end x < end y contains = flip during --- | Does x equal y?++{- | Does x `equals` y?++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+    ------ <- [y]+==========++Examples:++>>> x `equals` y+True++>>> y `equals` x+True+-} equals-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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)+  :: (Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a)   -> ComparativePredicateOf2 (i0 a) (i1 a)   -> ComparativePredicateOf2 (i0 a) (i1 a)@@ -453,33 +555,275 @@ strictWithinRelations :: Data.Set.Set IntervalRelation strictWithinRelations = Data.Set.difference withinRelations (toSet [Equals]) --- | Are x and y disjoint ('before', 'after', 'meets', or 'metBy')?++{- | Are x and y `disjoint` ('before', 'after', 'meets', or 'metBy')?++Example data with corresponding diagram:++>>> x = bi 3 0+>>> y = bi 3 5+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+---      <- [x]+     --- <- [y]+========++Examples:++>>> x `disjoint` y+True++>>> y `disjoint` x+True++Example data with corresponding diagram:++>>> x = bi 3 0+>>> y = bi 3 3+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+---    <- [x]+   --- <- [y]+======++Examples:++>>> x `disjoint` y+True++>>> y `disjoint` x+True++Example data with corresponding diagram:++>>> x = bi 6 0+>>> y = bi 3 3+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+------ <- [x]+   --- <- [y]+======++Examples:++>>> x `disjoint` y+False++>>> y `disjoint` x+False+-} disjoint-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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'.++{-| Does x `concur` with y? Is x `notDisjoint` with y?); This is+the 'complement' of 'disjoint'.++Example data with corresponding diagram:++>>> x = bi 3 0+>>> y = bi 3 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+---     <- [x]+    --- <- [y]+=======++Examples:++>>> x `notDisjoint` y+False+>>> y `concur` x+False++Example data with corresponding diagram:++>>> x = bi 3 0+>>> y = bi 3 3+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+---    <- [x]+   --- <- [y]+======++Examples:++>>> x `notDisjoint` y+False+>>> y `concur` x+False++Example data with corresponding diagram:++>>> x = bi 6 0+>>> y = bi 3 3+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+------ <- [x]+   --- <- [y]+======++Examples:++>>> x `notDisjoint` y+True+>>> y `concur` x+True+-} notDisjoint, concur-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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'?++{- | Is x `within` (`enclosedBy`) y? That is, 'during', 'starts', 'finishes', or+'equals'?++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+    ------ <- [y]+==========++Examples:++>>> x `within` y+True++>>> y `enclosedBy` x+True++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 5 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+    -----  <- [y]+==========++Examples:++>>> x `within` y+False++>>> y `enclosedBy` x+True++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 4 5+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+     ----  <- [y]+==========++Examples:++>>> x `within` y+False+>>> y `enclosedBy` x+True++Example data with corresponding diagram:++>>> x = bi 2 7+>>> y = bi 1 5+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+       -- <- [x]+     -    <- [y]+=========++Examples:++>>> x `within` y+False++>>> y `enclosedBy` x+False+-} within, enclosedBy-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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)++{- | Does x `encloses` y? That is, is y 'within' x?++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 6 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+    ------ <- [y]+==========++Examples:++>>> x `encloses` y+True++>>> y `encloses` x+True++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 5 4+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+    -----  <- [y]+==========++Examples:++>>> x `encloses` y+True++>>> y `encloses` x+False++Example data with corresponding diagram:++>>> x = bi 6 4+>>> y = bi 4 5+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+    ------ <- [x]+     ----  <- [y]+==========++Examples:++>>> x `encloses` y+True++>>> y `encloses` x+False++Example data with corresponding diagram:++>>> x = bi 2 7+>>> y = bi 1 5+>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []+       -- <- [x]+     -    <- [y]+=========++Examples:++>>> x `encloses` y+False++>>> y `encloses` x+False+-}+encloses+  :: (Ord a, Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a)-enclose = flip enclosedBy+encloses = flip enclosedBy  -- | The 'Data.Set.Set' of all 'IntervalRelation's. intervalRelations :: Data.Set.Set IntervalRelation@@ -495,7 +839,7 @@ toSet = Data.Set.fromList  -- | Compose a list of interval relations with _or_ to create a new--- @'ComparativePredicateOf1' i a@. For example, +-- @'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@@ -503,7 +847,7 @@  -- | Maps an 'IntervalRelation' to its corresponding predicate function. toPredicate-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => IntervalRelation   -> ComparativePredicateOf2 (i0 a) (i1 a) toPredicate r = case r of@@ -521,17 +865,17 @@   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-  :: (Intervallic i0 a, Intervallic i1 a)+  :: (Ord a, Intervallic i0, Intervallic i1)   => 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)+  :: (Ord a, Intervallic i0, Intervallic i1)   => Data.Set.Set IntervalRelation   -> ComparativePredicateOf2 (i0 a) (i1 a) predicate = unionPredicates . predicates@@ -582,16 +926,16 @@   cncr  = o ++ f' ++ d' ++ s ++ e ++ s' ++ d ++ f ++ o'   full  = p ++ m ++ cncr ++ m' ++ p' --- | Compare two @i a@ to determine their 'IntervalRelation'.------ >>> relate (Interval (0::Int, 1)) (Interval (1, 2))--- Meets------ >>> relate (Interval (1::Int, 2)) (Interval (0, 1))--- MetBy--- +{- | 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+  :: (Ord a, Intervallic i0, Intervallic i1) => i0 a -> i1 a -> IntervalRelation relate x y | x `before` y       = Before            | x `after` y        = After            | x `meets` y        = Meets@@ -606,9 +950,10 @@            | x `contains` y     = Contains            | otherwise          = Equals --- | Compose two interval relations according to the rules of the algebra.---   The rules are enumerated according to--- <https://thomasalspaugh.org/pub/fnd/allen.html#BasicCompositionsTable this table>.+{- | Compose 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)@@ -631,13 +976,12 @@   -> Data.Set.Set IntervalRelation union = Data.Set.union --- | Find the converse of a @'Data.Set.Set' 'IntervalRelation'@. +-- | 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-'Intervallic' type and to resize an 'Interval a'.+{- | The 'IntervalSizeable' typeclass provides functions to determine the size of+an 'Intervallic' type and to resize an 'Interval a'. -} class (Ord a, Num b, Ord b) => IntervalSizeable a b | a -> b where @@ -646,29 +990,41 @@     moment = 1      -- | Determine the duration of an @'i a'@.-    duration :: Intervallic i a => i a -> b+    duration :: (Intervallic i) => i a -> b     duration x = diff (end x) (begin x) -    -- | Shifts an @a@. Most often, the @b@ will be the same type as @a@. +    -- | Shifts an @a@. Most often, the @b@ will be the same type as @a@.     --   But for example, if @a@ is 'Day' then @b@ could be 'Int'.     add :: b -> a -> a      -- | Takes the difference between two @a@ to return a @b@.     diff :: a -> a -> b --- | Resize an @i a@ to by expanding to "left" by @l@ and to the ---   "right" by @r@. In the case that @l@ or @r@ are less than a 'moment'---   the respective endpoints are unchanged. ------ >>> expand 0 0 (Interval (0::Int, 2::Int))--- (0, 2)------ >>> expand 1 1 (Interval (0::Int, 2::Int))--- (-1, 3)---+{- | 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.++>>> iv2to4 = safeInterval (2::Int, 4::Int)+>>> iv2to4' = expand 0 0 iv2to4+>>> iv1to5 = expand 1 1 iv2to4++>>> iv2to4+(2, 4)++>>> iv2to4'+(2, 4)++>>> iv1to5+(1, 5)++>>> pretty $ standardExampleDiagram [(iv2to4, "iv2to4"), (iv1to5, "iv1to5")] []+  --  <- [iv2to4]+ ---- <- [iv1to5]+=====+-} expand   :: forall i a b-   . (IntervalSizeable a b, Intervallic i a)+   . (IntervalSizeable a b, Intervallic i)   => b -- ^ duration to subtract from the 'begin'   -> b -- ^ duration to add to the 'end'   -> i a@@ -679,38 +1035,60 @@   e = if r < moment @a then 0 else r   i = Interval (add s $ begin p, add e $ end p) --- | Expands an @i a@ to "left".------ >>> expandl 2 (Interval (0::Int, 2::Int))--- (-2, 2)----expandl :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a+{- | Expands an @i a@ to the "left".++>>> iv2to4 = (safeInterval (2::Int, 4::Int))+>>> iv0to4 = expandl 2 iv2to4++>>> iv2to4+(2, 4)++>>> iv0to4+(0, 4)++>>> pretty $ standardExampleDiagram [(iv2to4, "iv2to4"), (iv0to4, "iv0to4")] []+  -- <- [iv2to4]+---- <- [iv0to4]+====+-}+expandl :: (IntervalSizeable a b, Intervallic i) => b -> i a -> i a expandl i = expand i 0 --- | Expands an @i a@ to "right".------ >>> expandr 2 (Interval (0::Int, 2::Int))--- (0, 4)----expandr :: (IntervalSizeable a b, Intervallic i a) => b -> i a -> i a+{- | Expands an @i a@ to the "right".++>>> iv2to4 = (safeInterval (2::Int, 4::Int))+>>> iv2to6 = expandr 2 iv2to4++>>> iv2to4+(2, 4)++>>> iv2to6+(2, 6)++>>> pretty $ standardExampleDiagram [(iv2to4, "iv2to4"), (iv2to6, "iv2to6")] []+  --   <- [iv2to4]+  ---- <- [iv2to6]+======+-}+expandr :: (IntervalSizeable a b, Intervallic i) => 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 (0::Int) (0::Int)--- (0, 1)------ >>> beginerval (1::Int) (0::Int)--- (0, 1)------ >>> beginerval (2::Int) (0::Int)--- (0, 2)---+{- | Safely creates an 'Interval a' using @x@ as the 'begin' and adding @max+'moment' dur@ to @x@ as the 'end'.++>>> beginerval (0::Int) (0::Int)+(0, 1)++>>> beginerval (1::Int) (0::Int)+(0, 1)++>>> beginerval (2::Int) (0::Int)+(0, 2)+-} beginerval   :: forall a b    . (IntervalSizeable a b)-  => b -- ^ @dur@ation to add to the 'begin' +  => b -- ^ @dur@ation to add to the 'begin'   -> a -- ^ the 'begin' point of the 'Interval'   -> Interval a beginerval dur x = Interval (x, y)@@ -723,28 +1101,28 @@ -- | A synonym for `beginerval` bi   :: (IntervalSizeable a b)-  => b -- ^ @dur@ation to add to the 'begin' +  => b -- ^ @dur@ation to add to the 'begin'   -> a -- ^ the 'begin' point of the 'Interval'   -> Interval a bi = beginerval  --- | Safely creates an 'Interval a' using @x@ as the 'end' and adding---   @negate max 'moment' dur@ to @x@ as the 'begin'.------ >>> enderval (0::Int) (0::Int)--- (-1, 0)------ >>> enderval (1::Int) (0::Int)--- (-1, 0)------ >>> enderval (2::Int) (0::Int)--- (-2, 0)---+{- | Safely creates an 'Interval a' using @x@ as the 'end' and adding @negate max+'moment' dur@ to @x@ as the 'begin'.++>>> enderval (0::Int) (0::Int)+(-1, 0)++>>> enderval (1::Int) (0::Int)+(-1, 0)++>>> enderval (2::Int) (0::Int)+(-2, 0)+-} enderval   :: forall a b    . (IntervalSizeable a b)-  => b -- ^ @dur@ation to subtract from the 'end' +  => 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 @a) dur) x, x)@@ -754,14 +1132,14 @@ -- | A synonym for `enderval` ei   :: (IntervalSizeable a b)-  => b -- ^ @dur@ation to subtract from the 'end' +  => b -- ^ @dur@ation to subtract from the 'end'   -> a -- ^ the 'end' point of the 'Interval'   -> Interval a ei = enderval   -- | Safely creates an @'Interval'@ from a pair of endpoints.--- IMPORTANT: This function uses 'beginerval', +-- IMPORTANT: This function uses 'beginerval', -- thus if the second element of the pair is `<=` the first element, -- the duration will be an @"Interval"@ of 'moment' duration. --@@ -779,93 +1157,158 @@  -- | Creates a new Interval from the 'end' of an @i a@. beginervalFromEnd-  :: (IntervalSizeable a b, Intervallic i a)-  => b  -- ^ @dur@ation to add to the 'end' +  :: (IntervalSizeable a b, Intervallic i)+  => b  -- ^ @dur@ation to add to the 'end'   -> i a -- ^ the @i a@ from which to get the 'end'   -> Interval a beginervalFromEnd d i = beginerval d (end i)  -- | Creates a new Interval from the 'begin' of an @i a@. endervalFromBegin-  :: (IntervalSizeable a b, Intervallic i a)-  => b -- ^ @dur@ation to subtract from the 'begin'  +  :: (IntervalSizeable a b, Intervallic i)+  => b -- ^ @dur@ation to subtract from the 'begin'   -> i a -- ^ the @i a@ from which to get the 'begin'   -> Interval a endervalFromBegin d i = enderval d (begin i) --- | Safely creates a new @Interval@ with 'moment' length with 'begin' at @x@------ >>> beginervalMoment (10 :: Int)--- (10, 11)--- +{- | Safely creates a new @Interval@ with 'moment' length with 'begin' at @x@++>>> beginervalMoment (10 :: Int)+(10, 11)+-} beginervalMoment :: forall a b . (IntervalSizeable a b) => a -> Interval a beginervalMoment x = beginerval (moment @a) x where i = Interval (x, x) --- | Safely creates a new @Interval@ with 'moment' length with 'end' at @x@------ >>> endervalMoment (10 :: Int)--- (9, 10)--- +{- | Safely creates a new @Interval@ with 'moment' length with 'end' at @x@++>>> endervalMoment (10 :: Int)+(9, 10)+-} endervalMoment :: forall a b . (IntervalSizeable a b) => a -> Interval a endervalMoment x = enderval (moment @a) x where i = Interval (x, x) --- | Creates a new @Interval@ spanning the extent x and y.------ >>> extenterval (Interval (0, 1)) (Interval (9, 10))--- (0, 10)----extenterval :: Intervallic i a => i a -> i a -> Interval a+{- | Creates a new @Interval@ spanning the extent x and y.++>>> extenterval (Interval (0, 1)) (Interval (9, 10))+(0, 10)+-}+extenterval :: (Ord a, Intervallic i) => 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) --- | Modifies the endpoints of second argument's interval by taking the difference---   from the first's input's 'begin'. --- >>> shiftFromBegin (Interval ((5::Int), 6)) (Interval (10, 15))--- (5, 10)------ >>> shiftFromBegin (Interval ((1::Int), 2)) (Interval (3, 15))--- (2, 14)---+{- | Modifies the endpoints of second argument's interval by taking the difference+from the first's input's 'begin'.++Example data with corresponding diagram:++>>> a = bi 3 2 :: Interval Int+>>> a+(2, 5)+>>> x = bi 3 7 :: Interval Int+>>> x+(7, 10)+>>> y = bi 4 9 :: Interval Int+>>> y+(9, 13)+>>> pretty $ standardExampleDiagram [(a, "a"), (x, "x"), (y, "y")] []+  ---         <- [a]+       ---    <- [x]+         ---- <- [y]+=============++Examples:++>>> x' = shiftFromBegin a x+>>> x'+(5, 8)+>>> y' = shiftFromBegin a y+>>> y'+(7, 11)+>>> pretty $ standardExampleDiagram [(x', "x'"), (y', "y'")] []+     ---    <- [x']+       ---- <- [y']+===========+-} shiftFromBegin-  :: (IntervalSizeable a b, Functor i1, Intervallic i0 a)+  :: (IntervalSizeable a b, Intervallic i1, Intervallic i0)   => i0 a   -> i1 a   -> i1 b-shiftFromBegin i = fmap (`diff` begin i)+shiftFromBegin i = imapStrictMonotone (`diff` begin i) --- | Modifies the endpoints of second argument's interval by taking the difference---   from the first's input's 'end'.--- >>> shiftFromEnd (Interval ((5::Int), 6)) (Interval (10, 15))--- (4, 9)------ >>> shiftFromEnd (Interval ((1::Int), 2)) (Interval (3, 15))--- (1, 13)---+{- | Modifies the endpoints of second argument's interval by taking the difference+from the first's input's 'end'.++Example data with corresponding diagram:++>>> a = bi 3 2 :: Interval Int+>>> a+(2, 5)+>>> x = bi 3 7 :: Interval Int+>>> x+(7, 10)+>>> y = bi 4 9 :: Interval Int+>>> y+(9, 13)+>>> pretty $ standardExampleDiagram [(a, "a"), (x, "x"), (y, "y")] []+  ---         <- [a]+       ---    <- [x]+         ---- <- [y]+=============++Examples:++>>> x' = shiftFromEnd a x+>>> x'+(2, 5)+>>> y' = shiftFromEnd a y+>>> y'+(4, 8)+>>> pretty $ standardExampleDiagram [(x', "x'"), (y', "y'")] []+  ---    <- [x']+    ---- <- [y']+========+-} shiftFromEnd-  :: (IntervalSizeable a b, Functor i1, Intervallic i0 a)+  :: (IntervalSizeable a b, Intervallic i1, Intervallic i0)   => i0 a   -> i1 a   -> i1 b-shiftFromEnd i = fmap (`diff` end i)+shiftFromEnd i = imapStrictMonotone (`diff` end i) --- | Changes the duration of an 'Intervallic' value to a moment starting at the ---   'begin' of the interval.------ >>> momentize (Interval (6, 10))--- (6, 7)---+-- | Converts an @i a@ to an @i Int@ via @fromEnum@.  This assumes the provided+-- @fromEnum@ method is strictly monotone increasing: For @a@ types that are+-- @Ord@ with values @x, y@, then @x < y@ implies @fromEnum x < fromEnum y@, so+-- long as the latter is well-defined.+fromEnumInterval :: (Enum a, Intervallic i) => i a -> i Int+fromEnumInterval = imapStrictMonotone fromEnum++-- | Converts an @i Int@ to an @i a@ via @toEnum@.  This assumes the provided+-- @toEnum@ method is strictly monotone increasing: For @a@ types that are+-- @Ord@, then for @Int@ values @x, y@ it holds that @x < y@ implies @toEnum x+-- < toEnum y@.+toEnumInterval :: (Enum a, Intervallic i) => i Int -> i a+toEnumInterval = imapStrictMonotone toEnum++++{- | Changes the duration of an 'Intervallic' value to a moment starting at the+'begin' of the interval.++>>> momentize (Interval (6, 10))+(6, 7)+-} momentize-  :: forall i a b . (IntervalSizeable a b, Intervallic i a) => i a -> i a+  :: forall i a b . (IntervalSizeable a b, Intervallic i) => i a -> i a momentize i = setInterval i (beginerval (moment @a) (begin i)) -{- |-The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining-two @i a@s to form a @'Maybe' i a@, or in case of @><@, a possibly different -@Intervallic@ type.+{- | The @'IntervalCombinable'@ typeclass provides methods for (possibly)+combining two @i a@s to form a @'Maybe' i a@, or in case of @><@, a possibly+different @Intervallic@ type. -}-class (Intervallic i a) => IntervalCombinable i a where+class (Ord a, Intervallic i) => 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)@@ -876,20 +1319,20 @@             e = end y     {-# INLINABLE (.+.) #-} -    -- | If @x@ is 'before' @y@, then form a new @Just Interval a@ from the +    -- | If @x@ is 'before' @y@, then form a new @Just Interval a@ from the     --   interval in the "gap" between @x@ and @y@ from the 'end' of @x@ to the     --   'begin' of @y@. Otherwise, 'Nothing'.     (><) :: i a -> i a -> Maybe (i a) -    -- | If @x@ is 'before' @y@, return @f x@ appended to @f y@. Otherwise, -    --   return 'extenterval' of @x@ and @y@ (wrapped in @f@). This is useful for -    --   (left) folding over an *ordered* container of @Interval@s and combining +    -- | If @x@ is 'before' @y@, return @f x@ appended to @f y@. Otherwise,+    --   return 'extenterval' of @x@ and @y@ (wrapped in @f@). This is useful for+    --   (left) folding over an *ordered* container of @Interval@s and combining     --   intervals when @x@ is *not* 'before' @y@.     (<+>):: ( Semigroup (f (i a)), Applicative f) =>                i a             -> i a             -> f (i a)-+{-# DEPRECATED (<+>) "A specialized function without clear use-cases." #-}  {- Misc@@ -905,7 +1348,7 @@ -- Instances -- -} --- | Imposes a total ordering on @'Interval' a@ based on first ordering the +-- | Imposes a total ordering on @'Interval' a@ based on first ordering the --   'begin's then the 'end's. instance (Ord a) => Ord (Interval a) where   (<=) x y | begin x < begin y  = True@@ -915,7 +1358,7 @@           | begin x == begin y = end x < end y           | otherwise          = False -instance (Ord a) => Intervallic Interval a where+instance Intervallic Interval where   getInterval = id   setInterval _ x = x 

@@ -11,7 +11,6 @@                 ------         ============================== ->>> import Data.Time >>> let ref = bi 30 (fromGregorian 2022 5 6) >>> let ivs = [ bi 2 (fromGregorian 2022 5 6), bi 5 (fromGregorian 2022 5 10)] >>> pretty $ simpleIntervalDiagram ref ivs @@ -49,6 +48,7 @@   -}     parseIntervalDiagram   , simpleIntervalDiagram+  , standardExampleDiagram    -- * Diagram options   , IntervalDiagramOptions(..)@@ -64,6 +64,9 @@   , AxisParseError(..)   , IntervalDiagramOptionsError(..)   , IntervalDiagramParseError(..)++  -- * Re-exports+  , Prettyprinter.Pretty(..)   ) where  import           Data.Foldable                  ( Foldable(toList) )@@ -73,13 +76,26 @@ import           Data.Maybe                     ( fromMaybe                                                 , isNothing                                                 )-import           Data.Text                      ( Text )+import           Data.Text                      ( Text+                                                , pack+                                                ) import           IntervalAlgebra.Core+import           IntervalAlgebra.IntervalUtilities+                                                ( rangeInterval )+import           IntervalAlgebra.PairedInterval ( PairedInterval+                                                , getPairData+                                                , makePairedInterval+                                                ) import           Prettyprinter import           Witch                          ( From(..)                                                 , into                                                 ) +-- $setup+-- >>> :set -XTypeApplications -XFlexibleContexts -XOverloadedStrings+-- >>> import IntervalAlgebra.IntervalUtilities (gapsWithin)+-- >>> import Data.Time+ {- The key Type in this module is the IntervalDiagram, which has several components.@@ -103,36 +119,35 @@ Moreover, the type @b@ should be castable to @Int@, using its @'Witch.From' b Int@  instance. ->>> import Prettyprinter (pretty)->>> import IntervalAlgebra (beginerval)->>> pretty $ MkIntervalText '-' (beginerval 5 (0::Int))+>>> pretty $ makeIntervalText '-' (beginerval 5 (0::Int)) ------>>> pretty $ MkIntervalText '*' (beginerval 10 (0::Int))+>>> pretty $ makeIntervalText '*' (beginerval 10 (0::Int)) ********** -}--- NOTE: This type *could* be a PairedInterval,--- but I didn't do that in order to reduce depeendencies.-data IntervalText a = MkIntervalText Char (Interval a)-  deriving (Eq, Show) -instance (Ord a) => Intervallic IntervalText a where-  getInterval (MkIntervalText _ x) = x-  setInterval (MkIntervalText c _) = MkIntervalText c+newtype IntervalText a = MkIntervalText (PairedInterval Char a) deriving (Eq, Show) -instance Functor IntervalText where-  fmap f (MkIntervalText c i) = MkIntervalText c (fmap f i)+makeIntervalText :: Char -> Interval a -> IntervalText a+makeIntervalText c = MkIntervalText . makePairedInterval c +instance Intervallic IntervalText where+  getInterval (MkIntervalText x) = getInterval x+  setInterval (MkIntervalText x) i = MkIntervalText $ setInterval x i+ instance (Enum b, IntervalSizeable a b) => Pretty (IntervalText a) where-  pretty (MkIntervalText c i) = pretty $ replicate (fromEnum (duration i)) c+  pretty (MkIntervalText x) = pretty $ replicate (fromEnum (duration i)) c+   where+    c = getPairData x+    i = getInterval x  instance From (Char, Interval a) (IntervalText a) where-  from = uncurry MkIntervalText+  from = uncurry makeIntervalText  instance From (IntervalText a) Char where-  from (MkIntervalText c _) = c+  from (MkIntervalText x) = getPairData x  instance From (IntervalText a) (Interval a) where-  from (MkIntervalText _ i) = i+  from = getInterval  {-------------------------------------------------------------------------------   IntervalTextLine@@ -147,39 +162,39 @@ which checks that the inputs are parsed correctly to form intervals  that will be pretty-printed correctly. ->>> let i1 =  MkIntervalText '*' (beginerval 10 (5::Int))->>> let i2  = MkIntervalText '-' (beginerval 2 (1::Int))+>>> let i1 =  makeIntervalText '*' (beginerval 10 (5::Int))+>>> let i2  = makeIntervalText '-' (beginerval 2 (1::Int)) >>> let x = parseIntervalTextLine [] [i1, i2]  >>> pretty x UnsortedIntervals->>> let i1 =  MkIntervalText '*' (beginerval 10 (5::Int))->>> let i2  = MkIntervalText '-' (beginerval 2 (10::Int))+>>> let i1 =  makeIntervalText '*' (beginerval 10 (5::Int))+>>> let i2  = makeIntervalText '-' (beginerval 2 (10::Int)) >>> let x = parseIntervalTextLine [] [i1, i2]  >>> pretty x ConcurringIntervals->>> let i1 =  MkIntervalText '*' (beginerval 10 ((-1)::Int))->>> let i2  = MkIntervalText '-' (beginerval 2 (10::Int))+>>> let i1 =  makeIntervalText '*' (beginerval 10 ((-1)::Int))+>>> let i2  = makeIntervalText '-' (beginerval 2 (10::Int)) >>> let x = parseIntervalTextLine []  [i1, i2]  >>> pretty x BeginsLessThanZero->>> let i1 =  MkIntervalText '*' (beginerval  5 (0::Int))->>> let i2  = MkIntervalText '-' (beginerval 2 (10::Int))+>>> let i1 =  makeIntervalText '*' (beginerval  5 (0::Int))+>>> let i2  = makeIntervalText '-' (beginerval 2 (10::Int)) >>> let x = parseIntervalTextLine [] [i1, i2] >>> pretty x *****     --->>> let i1 =  MkIntervalText '*' (beginerval  5 (5::Int))->>> let i2  = MkIntervalText '-' (beginerval 2 (10::Int))+>>> let i1 =  makeIntervalText '*' (beginerval  5 (5::Int))+>>> let i2  = makeIntervalText '-' (beginerval 2 (10::Int)) >>> let x = parseIntervalTextLine [] [i1, i2] >>> pretty x      *****--->>> let i1 =  MkIntervalText '*' (beginerval  1 (5::Int))->>> let i2  = MkIntervalText '-' (beginerval 1 (7::Int))+>>> let i1 =  makeIntervalText '*' (beginerval  1 (5::Int))+>>> let i2  = makeIntervalText '-' (beginerval 1 (7::Int)) >>> let x = parseIntervalTextLine [] [i1, i2] >>> pretty x      * -->>> let i1 =  MkIntervalText '*' (beginerval  3 (5::Int))->>> let i2 = MkIntervalText '-' (beginerval 5 (10::Int))->>> let i3 = MkIntervalText '#' (beginerval 1 17)+>>> let i1 =  makeIntervalText '*' (beginerval  3 (5::Int))+>>> let i2 = makeIntervalText '-' (beginerval 5 (10::Int))+>>> let i3 = makeIntervalText '#' (beginerval 1 17) >>> pretty $ parseIntervalTextLine [] [i1, i2, i3]      ***  -----  # -}@@ -311,7 +326,7 @@  Use 'parseAxis' for construction. ->>> let ref = MkIntervalText '=' (beginerval 10 (0::Int))+>>> let ref = makeIntervalText '=' (beginerval 10 (0::Int))    >>> let b = parseAxis [] (Just Top) ref@@ -563,7 +578,6 @@ Here's a basic diagram that shows how to put more than one interval interval on a line: ->>> :set -XTypeApplications -XFlexibleContexts -XOverloadedStrings >>> let mkIntrvl c d b = into @(IntervalText Int) (c, bi d (b :: Int)) >>> let x = mkIntrvl  '=' 20 0 >>> let l1 = [ mkIntrvl '-' 1 4 ]@@ -575,6 +589,7 @@                   ## ==================== + We can put the axis on the top:  >>> pretty $ parseIntervalDiagram defaultIntervalDiagramOptions [] (Just Top) x [ (l1, []), (l2, []), (l3, []) ]@@ -584,7 +599,6 @@                   ##  - We can annotate the axis:  >>> pretty $ parseIntervalDiagram defaultIntervalDiagramOptions [(5, 'a')] (Just Bottom) x [ (l1, []), (l2, []), (l3, []) ]@@ -672,7 +686,7 @@     Shifts the endpoints of an interval to be referenced from another interval,     so that the 'begin' of the reference interval acts as the "zero" point.   -}-  rereference x = fmap (fromEnum . (`diff` begin x))+  rereference x = fromEnumInterval . shiftFromBegin x   rereferenceL x = fmap (rereference x)  {-|@@ -680,8 +694,6 @@ produces an 'IntervalDiagram' with one line per interval, using the 'defaultIntervalDiagramOptions'.  ->>> import Data.Maybe (fromMaybe)->>> import IntervalAlgebra.IntervalUtilities (gapsWithin) >>> pretty $ simpleIntervalDiagram (bi 10 (0 :: Int)) (fmap (bi 1) [0..9]) -  -@@ -711,7 +723,7 @@  -} simpleIntervalDiagram-  :: (Ord a, IntervalSizeable a b, Intervallic i a, Enum b)+  :: (Ord a, IntervalSizeable a b, Intervallic i, Enum b)   => i a -- ^ The axis interval   -> [i a] -- ^ List of intervals to be printed one per line   -> Either IntervalDiagramParseError (IntervalDiagram a)@@ -719,5 +731,66 @@   defaultIntervalDiagramOptions   []   (Just Bottom)-  (MkIntervalText '=' (getInterval ref))-  (fmap (\x -> (pure $ MkIntervalText '-' $ getInterval x, [])) ivs)+  (makeIntervalText '=' (getInterval ref))+  (fmap (\x -> (pure $ makeIntervalText '-' $ getInterval x, [])) ivs)++{- | Given various inputs containing intervals and their label, creates an+interval diagram with labels, along with a reference range that spans all of the+intervals and is extended to include 0 if necesary.++In more detail, an interval diagram is created with one row in the diagram for+each interval and label pair provided as the first input, and followed by a+sequence of additional rows with one row per list element in the second input+and such that each row displays each interval provided in the intervals list and+label pair.++>>> x1 = si (1, 5)+>>> x2 = si (7, 10)+>>> x3 = si (13, 15)+>>> ivs = [x1, x2, x3]+>>> gaps = [si (5, 7), si (10, 13)]+>>> :{+pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) [(gaps, "gaps")]+:}+ ----           <- [x1]+       ---      <- [x2]+             -- <- [x3]+     --   ---   <- [gaps]+===============++>>> :{+pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) []+:}+ ----           <- [x1]+       ---      <- [x2]+             -- <- [x3]+===============++>>> pretty $ standardExampleDiagram [] [(gaps, "gaps")]+     --   --- <- [gaps]+=============++>>> pretty $ standardExampleDiagram [] []+IntervalsExtendBeyondAxis+-}+standardExampleDiagram+  :: (Num a, Ord a, Enum b, IntervalSizeable a b)+  => [(Interval a, String)]+  -> [([Interval a], String)]+  -> Either IntervalDiagramParseError (IntervalDiagram a)+standardExampleDiagram ivs livs = op ref+ where+  op Nothing     = Left IntervalsExtendBeyondAxis+  op (Just ref') = parseIntervalDiagram defaultIntervalDiagramOptions+                                        []+                                        (Just Bottom)+                                        ref'+                                        combIvs+  range         = rangeInterval $ map fst ivs ++ concatMap fst livs+  anchoredRange = case range of+    Nothing  -> Nothing+    (Just x) -> Just $ safeInterval (min (begin x) 0, max (end x) 0)+  ref = fmap (makeIntervalText '=') anchoredRange+  f (iv, s) = ([iv], s)+  g (ivs, s) = (map (makeIntervalText '-') ivs, [pack s])+  combIvs = map (g . f) ivs ++ map g livs

@@ -12,7 +12,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-}-+{-# LANGUAGE ScopedTypeVariables #-}  module IntervalAlgebra.IntervalUtilities   (@@ -20,6 +20,8 @@     -- * Fold over sequential intervals     combineIntervals   , combineIntervalsL+  , combineIntervalsFromSorted+  , combineIntervalsFromSortedL   , rangeInterval   , gaps   , gapsL@@ -55,7 +57,7 @@   , filterNotDisjoint   , filterConcur   , filterWithin-  , filterEnclose+  , filterEncloses   , filterEnclosedBy      -- * Functions for manipulating intervals@@ -90,7 +92,12 @@                                                 , (||)                                                 ) import safe      Data.Eq                        ( Eq((==)) )-import safe      Data.Foldable                  ( Foldable(foldl', null, toList)+import safe      Data.Foldable                  ( Foldable+                                                  ( foldl'+                                                  , foldr+                                                  , null+                                                  , toList+                                                  )                                                 , all                                                 , any                                                 , or@@ -99,6 +106,10 @@                                                 , (.)                                                 , flip                                                 )+import safe      Data.List                      ( map+                                                , reverse+                                                , sortOn+                                                ) import safe      Data.Maybe                     ( Maybe(..)                                                 , maybe                                                 , maybeToList@@ -119,10 +130,7 @@                                                 , ComparativePredicateOf1                                                 , ComparativePredicateOf2                                                 , Interval-                                                , IntervalCombinable-                                                  ( (<+>)-                                                  , (><)-                                                  )+                                                , IntervalCombinable((><))                                                 , IntervalRelation(..)                                                 , IntervalSizeable                                                   ( diff@@ -134,12 +142,13 @@                                                 , begin                                                 , beginerval                                                 , beginervalFromEnd+                                                , bi                                                 , concur                                                 , contains                                                 , disjoint                                                 , during-                                                , enclose                                                 , enclosedBy+                                                , encloses                                                 , end                                                 , enderval                                                 , endervalFromBegin@@ -173,15 +182,16 @@                                                 , mapMaybe                                                 ) +{- $setup+>>> import GHC.List ( (++), zip )+>>> import IntervalAlgebra.IntervalDiagram+>>> import Prettyprinter ( pretty )+-}  ------------------------------------------------- -- Unexported utilties used in functions below -- ------------------------------------------------- --- Just a synonym used to examples to save typing-iv :: Int -> Int -> Interval Int-iv = beginerval- -- An internal utility function for creating a @Fold@ that maps over a structure -- by consecutive pairs into a new structure. makeFolder :: (Monoid (m b), Applicative m) => (a -> a -> b) -> L.Fold a (m b)@@ -201,7 +211,7 @@      , Applicative t      , Witherable.Witherable t      , IntervalSizeable a b-     , Intervallic i0 a+     , Intervallic i0      , IntervalCombinable i1 a      )   => ((b -> Bool) -> t b -> Bool)@@ -213,7 +223,7 @@ -- | Gets the durations of gaps (via 'IntervalAlgebra.(><)') between all pairs --   of the input. pairGaps-  :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a)+  :: (Intervallic i, IntervalSizeable a b, IntervalCombinable i a)   => [i a]   -> [Maybe b] pairGaps es = fmap (fmap duration . uncurry (><)) (pairs es)@@ -233,7 +243,7 @@ -- >>> lookback 4 (beginerval 10 (1 :: Int)) -- (-3, 1) lookback-  :: (Intervallic i a, IntervalSizeable a b)+  :: (Intervallic i, IntervalSizeable a b)   => b   -- ^ lookback duration   -> i a   -> Interval a@@ -245,7 +255,7 @@ -- >>> lookahead 4 (beginerval 1 (1 :: Int)) -- (2, 6) lookahead-  :: (Intervallic i a, IntervalSizeable a b)+  :: (Intervallic i, IntervalSizeable a b)   => b   -- ^ lookahead duration   -> i a   -> Interval a@@ -255,7 +265,7 @@ --   specified duration among the input intervals? anyGapsWithinAtLeastDuration   :: ( IntervalSizeable a b-     , Intervallic i0 a+     , Intervallic i0      , IntervalCombinable i1 a      , Monoid (t (Interval a))      , Monoid (t (Maybe (Interval a)))@@ -275,7 +285,7 @@ -- True allGapsWithinLessThanDuration   :: ( IntervalSizeable a b-     , Intervallic i0 a+     , Intervallic i0      , IntervalCombinable i1 a      , Monoid (t (Interval a))      , Monoid (t (Maybe (Interval a)))@@ -304,21 +314,27 @@ -- | Returns a list of the 'IntervalRelation' between each consecutive pair  --   of intervals. This is just a specialized 'relations' which returns a list. ----- >>> relationsL [iv 1 0, iv 1 1] +-- >>> relationsL [bi 1 0, bi 1 1] -- [Meets] ---relationsL :: (Foldable f, Intervallic i a) => f (i a) -> [IntervalRelation]+relationsL+  :: (Foldable f, Ord a, Intervallic i) => f (i a) -> [IntervalRelation] relationsL = relations  -- | A generic form of 'relations' which can output any 'Applicative' and  --   'Monoid' structure. ----- >>> (relations [iv 1 0,iv 1 1]) :: [IntervalRelation]+-- >>> (relations [bi 1 0,bi 1 1]) :: [IntervalRelation] -- [Meets] -- -- relations-  :: (Foldable f, Applicative m, Intervallic i a, Monoid (m IntervalRelation))+  :: ( Foldable f+     , Applicative m+     , Ord a+     , Intervallic i+     , Monoid (m IntervalRelation)+     )   => f (i a)   -> m IntervalRelation relations = L.fold (makeFolder relate)@@ -327,11 +343,11 @@ -- | Forms a 'Just' new interval from the intersection of two intervals,  --   provided the intervals are not disjoint. -- --- >>> intersect (iv 5 0) (iv 2 3)+-- >>> intersect (bi 5 0) (bi 2 3) -- Just (3, 5) -- intersect-  :: (Intervallic i a, IntervalSizeable a b) => i a -> i a -> Maybe (Interval a)+  :: (Intervallic i, IntervalSizeable a b) => i a -> i a -> Maybe (Interval a) intersect x y | disjoint x y = Nothing               | otherwise    = Just $ beginerval (diff e b) b  where@@ -351,13 +367,45 @@ gapsM = L.fold (makeFolder (\i j -> getInterval i >< getInterval j)) {-# INLINABLE gapsM #-} --- | Returns a @Maybe@ container of intervals consisting of the gaps ---   between intervals in the input. *To work properly, the input should be---   sorted*. See 'gapsL' for a version that always returns a list.------ >>> gaps [iv 4 1, iv 4 8, iv 3 11]--- Nothing---+{- | Returns a @Maybe@ container of intervals consisting of the gaps between+intervals in the input. __To work properly, the input should be sorted.__ See+'gapsL' for a version that always returns a list.++>>> x1 = bi 4 1+>>> x2 = bi 4 8+>>> x3 = bi 3 11+>>> ivs = [x1, x2, x3]+>>> ivs+[(1, 5),(8, 12),(11, 14)]+>>> gaps ivs+Nothing+>>> pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) []+ ----          <- [x1]+        ----   <- [x2]+           --- <- [x3]+==============++>>> x1 = bi 4 1+>>> x2 = bi 3 7+>>> x3 = bi 2 13+>>> ivs = [x1, x2, x3]+>>> ivs+[(1, 5),(7, 10),(13, 15)]+>>> gapIvs = gaps ivs+>>> gapIvs+Just [(5, 7),(10, 13)]+>>> :{+case gapIvs of+  Nothing -> pretty ""+  (Just x) -> pretty $+    standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) [(x, "gapIvs")]+:}+ ----           <- [x1]+       ---      <- [x2]+             -- <- [x3]+     --   ---   <- [gapIvs]+===============+-} gaps   :: ( IntervalCombinable i a      , Traversable f@@ -369,10 +417,47 @@ gaps = sequenceA . gapsM {-# INLINABLE gaps #-} --- | Returns a (possibly empty) list of intervals consisting of the gaps between---   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@.+{- | Returns a (possibly empty) list of intervals consisting of the gaps between+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@.++>>> x1 = bi 4 1+>>> x2 = bi 4 8+>>> x3 = bi 3 11+>>> ivs = [x1, x2, x3]+>>> ivs+[(1, 5),(8, 12),(11, 14)]+>>> gapIvs = gapsL ivs+>>> gapIvs+[]+>>> :{+pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) []+:}+ ----          <- [x1]+        ----   <- [x2]+           --- <- [x3]+==============++>>> x1 = bi 4 1+>>> x2 = bi 3 7+>>> x3 = bi 2 13+>>> ivs = [x1, x2, x3]+>>> ivs+[(1, 5),(7, 10),(13, 15)]+>>> gapIvs = gapsL ivs+>>> gapIvs+[(5, 7),(10, 13)]+>>> :{+pretty $+  standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) [(gapIvs, "gapIvs")]+:}+ ----           <- [x1]+       ---      <- [x2]+             -- <- [x3]+     --   ---   <- [gapIvs]+===============+-} gapsL   :: ( IntervalCombinable i a      , Applicative f@@ -386,23 +471,22 @@  -- | Returns the 'duration' of each 'Intervallic i a' in the 'Functor' @f@. ----- >>> durations [iv 9 1, iv 10 2, iv 1 5]+-- >>> durations [bi 9 1, bi 10 2, bi 1 5 :: Interval Int] -- [9,10,1] ---durations-  :: (Functor f, Intervallic i a, IntervalSizeable a b) => f (i a) -> f b+durations :: (Functor f, Intervallic i, IntervalSizeable a b) => f (i a) -> f b durations = fmap duration  -- | In the case that x y are not disjoint, clips y to the extent of x. -- --- >>> clip (iv 5 0) (iv 3 3)+-- >>> clip (bi 5 0) ((bi 3 3) :: Interval Int) -- Just (3, 5) ----- >>> clip (iv 3 0) (iv 2 4)+-- >>> clip (bi 3 0) ((bi 2 4) :: Interval Int) -- Nothing -- clip-  :: (Intervallic i0 a, Intervallic i1 a, IntervalSizeable a b)+  :: (Intervallic i0, Intervallic i1, IntervalSizeable a b)   => i0 a   -> i1 a   -> Maybe (Interval a)@@ -417,14 +501,14 @@   jx = starts <|> during <|> finishes {-# INLINABLE clip #-} --- | Applies 'gaps' to all the non-disjoint intervals in @x@ that are *not* disjoint+-- | 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@, so that all the intervals are 'within' @i@. If all of the input intervals  -- are disjoint from the focal interval or if the input is empty, then 'Nothing'  -- is returned. When there are no gaps among the concurring intervals, then --- `Just mempty` (e.g. `Just []`) is returned.+-- @Just mempty@ (e.g. @Just []@) is returned. ----- >>> gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12]+-- >>> gapsWithin (bi 9 1) [bi 5 0, bi 2 7, bi 3 12] -- Just [(5, 7),(9, 10)] -- gapsWithin@@ -433,7 +517,7 @@      , Monoid (f (Interval a))      , Monoid (f (Maybe (Interval a)))      , IntervalSizeable a b-     , Intervallic i0 a+     , Intervallic i0      , IntervalCombinable i1 a      )   => i0 a  -- ^ i@@ -448,72 +532,153 @@   res = catMaybes $ gapsM (s <> ivs <> e) {-# INLINABLE gapsWithin #-} --- The Box is an internal type used to hold accumulated, combined intervals in --- 'combineIntervalsL'.-newtype Box a = Box { unBox :: [a] }+{- | Returns a container of intervals where any intervals that meet or share+support are combined into one interval. This functions sorts the input intervals+first. See @combineIntervalsL@ for a version that works only on lists. If you+know the input intervals are sorted, use @combineIntervalsFromSorted@ instead. -packIntervalBoxes :: (Intervallic i a) => [i a] -> [Box (Interval a)]-packIntervalBoxes = fmap (\z -> Box [getInterval z])+>>> x1 = bi 10 0+>>> x2 = bi 5 2+>>> x3 = bi 2 10+>>> x4 = bi 2 13+>>> ivs = [x1, x2, x3, x4]+>>> ivs+[(0, 10),(2, 7),(10, 12),(13, 15)]+>>> xComb = combineIntervals ivs+>>> xComb+[(0, 12),(13, 15)]+>>> :{+pretty $+  standardExampleDiagram+    (zip ivs ["x1", "x2", "x3", "x4"])+    [(xComb, "xComb")]+:}+----------      <- [x1]+  -----         <- [x2]+          --    <- [x3]+             -- <- [x4]+------------ -- <- [xComb]+===============+-}+combineIntervals+  :: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)+  => f (i a)+  -> f (Interval a)+combineIntervals = combineIntervalsWith combineIntervalsL -instance (Ord a) => Semigroup (Box (Interval a)) where-  Box x <> Box y = Box $ listCombiner (<->) x y+{- | Returns a container of intervals where any intervals that meet or share+support are combined into one interval. The condition is applied cumulatively,+from left to right, so+__to work properly, the input list should be sorted in increasing order__. See+@combineIntervalsLFromSorted@ for a version that works only on lists. --- | 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 'combineIntervalsL' for a version that works only on lists.------ >>> combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]--- [(0, 12),(13, 15)]----combineIntervals-  :: ( Applicative f-     , Ord a-     , Intervallic i a-     , Monoid (f (Interval a))-     , Foldable f-     )+>>> combineIntervalsFromSorted [bi 10 0, bi 5 2, bi 2 10, bi 2 13]+[(0, 12),(13, 15)]+-}+combineIntervalsFromSorted+  :: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)   => f (i a)   -> f (Interval a)-combineIntervals x =-  foldl' (\x y -> x <> pure y) mempty (combineIntervalsL $ toList x)-  -- TODO: surely combineIntervals and combineIntervalsL could be combined-{-# INLINABLE combineIntervals #-}+combineIntervalsFromSorted = combineIntervalsWith combineIntervalsFromSortedL --- | 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*. ------ >>> combineIntervalsL [iv 10 0, iv 5 2, iv 2 10, iv 2 13]--- [(0, 12),(13, 15)]----combineIntervalsL :: (Intervallic i a) => [i a] -> [Interval a]-combineIntervalsL l = unBox $ foldl' (<>) (Box []) (packIntervalBoxes l)-{-# INLINABLE combineIntervalsL #-}+-- | Unexported helper+combineIntervalsWith+  :: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)+  => ([i a] -> [Interval a])+  -> f (i a)+  -> f (Interval a)+combineIntervalsWith f x = foldl' (\x y -> x <> pure y) mempty (f $ toList x) --- |--- Maybe form an @Interval a@ from @Control.Foldl t => t (Interval a)@ spanning--- the range of all intervals in the list, i.e.  whose @begin@ is the minimum--- of @begin@ across intervals in the list and whose @end@ is the maximum of--- @end@. ------ >>> rangeInterval [beginerval 0 0, beginerval 0 (-1)]--- Just (-1, 1)--- >>> rangeInterval ([] :: [Interval Int])--- Nothing--- >>> rangeInterval (Just (beginerval 0 0))--- Just (0, 1)+{- | Returns a list of intervals where any intervals that meet or share support+are combined into one interval. This function sorts the input. If you know the+input intervals are sorted, use @combineIntervalsLFromSorted@.++>>> x1 = bi 10 0+>>> x2 = bi 5 2+>>> x3 = bi 2 10+>>> x4 = bi 2 13+>>> ivs = [x1, x2, x3, x4]+>>> ivs+[(0, 10),(2, 7),(10, 12),(13, 15)]+>>> xComb = combineIntervalsL ivs+>>> xComb+[(0, 12),(13, 15)]+>>> :{+pretty $+  standardExampleDiagram+    (zip ivs ["x1", "x2", "x3", "x4"])+    [(xComb, "xComb")]+:}+----------      <- [x1]+  -----         <- [x2]+          --    <- [x3]+             -- <- [x4]+------------ -- <- [xComb]+===============+-}+combineIntervalsL :: (Intervallic i, Ord a) => [i a] -> [Interval a]+combineIntervalsL = combineIntervalsFromSortedL . sortOn getInterval++{- | Returns a list of intervals where any intervals that meet or share support+are combined into one interval. The operation is applied cumulatively, from left+to right, so+__to work properly, the input list should be sorted in increasing order__.++>>> combineIntervalsFromSortedL [bi 10 0, bi 5 2, bi 2 10, bi 2 13]+[(0, 12),(13, 15)]++>>> combineIntervalsFromSortedL [bi 10 0, bi 5 2, bi 0 8]+[(0, 10)]+-}+combineIntervalsFromSortedL+  :: forall a i . (Ord a, Intervallic i) => [i a] -> [Interval a]+combineIntervalsFromSortedL = reverse . foldl' op []+ where+  op []       y = [getInterval y]+  op (x : xs) y = if x `before` y+    -- Since x <= y, not (x `before` y) iff they meet or share support+    then yiv : x : xs+    else extenterval x yiv : xs+    where yiv = getInterval y++{- | @Maybe@ form an @Interval a@ from @Control.Foldl t => t (Interval a)@+spanning the range of all intervals in the list, i.e. whose @begin@ is the+minimum of @begin@ across intervals in the list and whose @end@ is the maximum+of @end@.++>>> rangeInterval ([] :: [Interval Int])+Nothing++>>> x1 = bi 2 2+>>> x2 = bi 3 6+>>> x3 = bi 4 7+>>> ivs = [x1, x2, x3] :: [Interval Int]+>>> ivs+[(2, 4),(6, 9),(7, 11)]+>>> spanIv = rangeInterval ivs+>>> spanIv+Just (2, 11)+>>> :{+case spanIv of+  Nothing -> pretty ""+  (Just x) -> pretty $ standardExampleDiagram+    (zip (ivs ++ [x]) ["x1", "x2", "x3", "spanIv"])+    []+:}+  --        <- [x1]+      ---   <- [x2]+       ---- <- [x3]+  --------- <- [spanIv]+===========++>>> rangeInterval Nothing+Nothing+>>> rangeInterval (Just (bi 1 0))+Just (0, 1)+-} rangeInterval :: (Ord a, L.Foldable t) => t (Interval a) -> Maybe (Interval a) rangeInterval = L.fold (liftA2 extenterval <$> L.minimum <*> L.maximum) --- Internal function for combining maybe intervals in the 'combineIntervalsL' --- function-(<->) :: (IntervalCombinable i a) => Maybe (i a) -> Maybe (i a) -> [Interval a]-(<->) Nothing  Nothing  = []-(<->) Nothing  (Just y) = [getInterval y]-(<->) (Just x) Nothing  = [getInterval x]-(<->) (Just x) (Just y) = (<+>) (getInterval x) (getInterval y)-{-# INLINABLE (<->) #-}- -- | 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.@@ -532,12 +697,12 @@ -- For example, the following returns 'Nothing' because none of the intervals -- in the input list 'starts' (3, 5). ----- >>> nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5]+-- >>> nothingIfNone (starts (bi 2 3)) [bi 1 3, bi 1 5] -- Nothing -- -- In the following, (3, 5) 'starts' (3, 6), so 'Just' the input is returned. ----- >>> nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5]+-- >>> nothingIfNone (starts (bi 2 3)) [bi 3 3, bi 1 5] -- Just [(3, 6),(5, 6)] -- nothingIfNone@@ -549,10 +714,10 @@  -- | Returns 'Nothing' if *any* of the element of input satisfy the predicate condition. ----- >>> nothingIfAny (startedBy (iv 2 3)) [iv 3 3, iv 1 5]+-- >>> nothingIfAny (startedBy (bi 2 3)) [bi 3 3, bi 1 5] -- Just [(3, 6),(5, 6)] ----- >>> nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 1 5]+-- >>> nothingIfAny (starts (bi 2 3)) [bi 3 3, bi 1 5] -- Nothing -- nothingIfAny@@ -564,7 +729,7 @@  -- | Returns 'Nothing' if *all* of the element of input satisfy the predicate condition. ----- >>> nothingIfAll (starts (iv 2 3)) [iv 3 3, iv 4 3]+-- >>> nothingIfAll (starts (bi 2 3)) [bi 3 3, bi 4 3] -- Nothing -- nothingIfAll@@ -577,7 +742,7 @@ -- | Creates a function for filtering a 'Witherable.Filterable' of @i1 a@s  --   by comparing the @Interval a@s that of an @i0 a@.  makeFilter-  :: (Filterable f, Intervallic i0 a, Intervallic i1 a)+  :: (Filterable f, Intervallic i0, Intervallic i1)   => ComparativePredicateOf2 (i0 a) (i1 a)   -> i0 a   -> (f (i1 a) -> f (i1 a))@@ -588,8 +753,8 @@ 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)+filterOverlaps, filterOverlappedBy, filterBefore, filterAfter, filterStarts, filterStartedBy, filterFinishes, filterFinishedBy, filterMeets, filterMetBy, filterDuring, filterContains, filterEquals, filterDisjoint, filterNotDisjoint, filterConcur, filterWithin, filterEncloses, filterEnclosedBy+  :: (Filterable f, Ord a, Intervallic i0, Intervallic i1)   => i0 a   -> f (i1 a)   -> f (i1 a)@@ -610,7 +775,7 @@ filterNotDisjoint = makeFilter notDisjoint filterConcur = makeFilter concur filterWithin = makeFilter within-filterEnclose = makeFilter enclose+filterEncloses = makeFilter encloses filterEnclosedBy = makeFilter enclosedBy  -- | Folds over a list of Paired Intervals and in the case that the 'getPairData' @@ -644,7 +809,7 @@ packMeeting = fmap (\z -> Meeting [z])  -- Test a list of intervals to be sure they all meet; if not return Nothing.-parseMeeting :: Intervallic i a => [i a] -> Maybe (Meeting [i a])+parseMeeting :: (Ord a, Intervallic i) => [i a] -> Maybe (Meeting [i a]) parseMeeting x | all (== Meets) (relationsL x) = Just $ Meeting x                | otherwise                     = Nothing @@ -658,7 +823,7 @@  -- A general function for combining any two @Meeting [i a]@ by 'listCombiner'. joinMeeting-  :: Intervallic i a+  :: (Ord a, Intervallic i)   => ComparativePredicateOf1 (i a)   -> Meeting [i a]   -> Meeting [i a]@@ -669,7 +834,7 @@ -- The intervals @x@ and @y@ should meet! The predicate function @p@ determines -- when the two intervals that meet should be combined. join2MeetingWhen-  :: Intervallic i a+  :: (Ord a, Intervallic i)   => ComparativePredicateOf1 (i a)   -> Maybe (i a)   -> Maybe (i a)@@ -789,4 +954,3 @@  hasEqData :: (Eq b) => [PairedInterval b a] -> Bool hasEqData x = or (L.fold (makeFolder (==)) (fmap getPairData x) :: [Bool])-

@@ -25,12 +25,12 @@  import safe      Control.Applicative            ( liftA2 ) import safe      Control.DeepSeq                ( NFData )-import safe      Data.Bifunctor                 ( Bifunctor(bimap) ) import safe      Data.Binary                    ( Binary ) import safe      GHC.Generics                   ( Generic ) import safe      IntervalAlgebra.Core           ( ComparativePredicateOf1                                                 , Interval                                                 , IntervalCombinable(..)+                                                , IntervalSizeable                                                 , Intervallic(..)                                                 , before                                                 , extenterval@@ -42,15 +42,9 @@ newtype PairedInterval b a = PairedInterval (Interval a, b)     deriving (Eq, Generic) -instance (Ord a) => Intervallic (PairedInterval b) a where+instance Intervallic (PairedInterval b) where   getInterval (PairedInterval x) = fst x   setInterval (PairedInterval (x, y)) i = PairedInterval (i, y)--instance Functor (PairedInterval b) where-  fmap f (PairedInterval (x, y)) = PairedInterval (fmap f x, y)--instance Bifunctor PairedInterval where-  bimap f g (PairedInterval (x, y)) = PairedInterval (fmap g x, f y)  instance (NFData a, NFData b) => NFData (PairedInterval b a) instance (Binary a, Binary b) => Binary (PairedInterval b a)

@@ -145,11 +145,11 @@         -> Property     prop_enclosedBy_predicate = prop_predicate_unions withinRelations enclosedBy -    prop_enclose_predicate :: (Ord a) =>+    prop_encloses_predicate :: (Ord a) =>           Interval a         -> Interval a         -> Property-    prop_enclose_predicate = prop_predicate_unions (converse withinRelations) enclose+    prop_encloses_predicate = prop_predicate_unions (converse withinRelations) encloses  instance IntervalRelationProperties Int Int instance IntervalRelationProperties Day Integer

@@ -32,7 +32,7 @@         it "during" $ property (prop_IAduring @Int)         it "disjoint" $ property (prop_disjoint_predicate @Int)         it "within" $ property (prop_within_predicate @Int)-        it "enclose" $ property (prop_enclose_predicate @Int)+        it "encloses" $ property (prop_encloses_predicate @Int)         it "enclosedBy" $ property (prop_enclosedBy_predicate @Int)         it "notDisjoint" $ property (prop_notdisjoint_predicate @Int)         it "concur" $ property (prop_concur_predicate @Int)@@ -47,7 +47,7 @@         it "during" $ property (prop_IAduring @Day)         it "disjoint" $ property (prop_disjoint_predicate @Day)         it "within" $ property (prop_within_predicate @Day)-        it "enclose" $ property (prop_enclose_predicate @Day)+        it "encloses" $ property (prop_encloses_predicate @Day)         it "enclosedBy" $ property (prop_enclosedBy_predicate @Day)         it "notDisjoint" $ property (prop_notdisjoint_predicate @Day)         it "concur" $ property (prop_concur_predicate @Day)@@ -62,7 +62,7 @@         it "during" $ property (prop_IAduring @UTCTime)         it "disjoint" $ property (prop_disjoint_predicate @UTCTime)         it "within" $ property (prop_within_predicate @UTCTime)-        it "enclose" $ property (prop_enclose_predicate @UTCTime)+        it "encloses" $ property (prop_encloses_predicate @UTCTime)         it "enclosedBy" $ property (prop_enclosedBy_predicate @UTCTime)         it "notDisjoint" $ property (prop_notdisjoint_predicate @UTCTime)         it "concur" $ property (prop_concur_predicate @UTCTime)

@@ -45,6 +45,7 @@ import           IntervalAlgebra.IntervalUtilities                                                 ( clip                                                 , combineIntervals+                                                , combineIntervalsFromSorted                                                 , durations                                                 , filterAfter                                                 , filterBefore@@ -52,8 +53,8 @@                                                 , filterContains                                                 , filterDisjoint                                                 , filterDuring-                                                , filterEnclose                                                 , filterEnclosedBy+                                                , filterEncloses                                                 , filterEquals                                                 , filterFinishedBy                                                 , filterFinishes@@ -172,7 +173,7 @@     pure $ IntervalReferenced refIv rels iv  -- Testing functions-checkSeqStates :: (Intervallic i Int) => [i Int] -> Bool+checkSeqStates :: (Intervallic i) => [i Int] -> Bool checkSeqStates x = (length x > 1) || all (== Meets) (relationsL x)  -- Creation functions@@ -438,10 +439,10 @@       -> Property    prop_filterEnclosedBy = prop_filtration filterEnclosedBy withinRelations -   prop_filterEnclose :: Interval a+   prop_filterEncloses :: Interval a       -> [Interval a]       -> Property-   prop_filterEnclose = prop_filtration filterEnclose (converse withinRelations)+   prop_filterEncloses = prop_filtration filterEncloses (converse withinRelations)     prop_filterConcur :: Interval a       -> [Interval a]@@ -568,7 +569,7 @@     it "filterNotDisjoint property" $ property (prop_filterNotDisjoint @Int)     it "filterWithin property" $ property (prop_filterWithin @Int)     it "filterConcur property" $ property (prop_filterConcur @Int)-    it "filterEnclose property" $ property (prop_filterEnclose @Int)+    it "filterEncloses property" $ property (prop_filterEncloses @Int)     it "filterEnclosedBy property" $ property (prop_filterEnclosedBy @Int)    describe "nothingIf unit tests" $ do@@ -656,8 +657,14 @@     it "combineIntervals [] should be []"       $          combineIntervals ([] :: [Interval Int])       `shouldBe` []-    it "combineIntervals [(0, 10), (2, 7), (10, 12), (13, 15)]"+    it "combineIntervals works on sorted intervals"       $          combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]+      `shouldBe` [iv 12 0, iv 2 13]+    it "combineIntervalsFromSorted works on sorted intervals"+      $          combineIntervalsFromSorted [iv 10 0, iv 5 2, iv 2 10, iv 2 13]+      `shouldBe` [iv 12 0, iv 2 13]+    it "combineIntervals works on unsorted intervals"+      $          combineIntervals [iv 2 13, iv 10 0, iv 2 10, iv 5 2]       `shouldBe` [iv 12 0, iv 2 13]    describe "combineIntervals property tests" $ modifyMaxSuccess (* 10) $ do

@@ -2,7 +2,6 @@   ( spec   ) where -import           Data.Bifunctor                 ( Bifunctor(bimap) ) import           Data.Bool import           Data.Time                      ( Day(ModifiedJulianDay)                                                 , fromGregorian@@ -12,6 +11,7 @@                                                 , before                                                 , beginerval                                                 , equals+                                                , toEnumInterval                                                 ) import           IntervalAlgebra.PairedInterval ( Empty(..)                                                 , PairedInterval@@ -43,15 +43,11 @@   describe "Basic tests of paired intervals" $ do     it "the same pairInterval should be equal" $ t1 == t1 `shouldBe` True     it "different pairInterval should not be equal" $ t1 /= t2 `shouldBe` True-    it "fmapping into a different interval type"-      $ fmap ModifiedJulianDay (makePairedInterval "hi" (beginerval 5 0))+    -- NOTE toEnum (fromGregorian 1858 11 17) is 0, since that date is the+    -- origin in the modified Julian calendar.+    it "toEnumInterval into PairedInterval b Day"+      $          toEnumInterval (makePairedInterval "hi" (beginerval 5 0))       `shouldBe` makePairedInterval "hi"-                                    (beginerval 5 (fromGregorian 1858 11 17))-    it "bimapping into a different type"-      $          bimap (== "hi")-                       ModifiedJulianDay-                       (makePairedInterval "hi" (beginerval 5 0))-      `shouldBe` makePairedInterval True                                     (beginerval 5 (fromGregorian 1858 11 17))     it "show paired interval" $ show t1 `shouldBe` "{(0, 5), \"hi\"}" 

@@ -120,9 +120,12 @@       $          show (beginerval 10 (0 :: Int))       `shouldBe` "(0, 10)" -    it "fmap can convert Interval Integer to Interval Day"-      $          fmap ModifiedJulianDay (beginerval 1 0)-      `shouldBe` beginerval 1 (fromGregorian 1858 11 17)+    -- NOTE toEnum (fromGregorian 1858 11 17) is 0,+    -- since that date is the origin in the modified+    -- Julian calendar.+    it "fromEnumInterval converts Interval Day"+      $          fromEnumInterval (beginerval 0 (fromGregorian 1858 11 17))+      `shouldBe` beginerval 0 0      it "(0, 2) <= (1, 3) is True"       $          beginerval 2 (0 :: Int)@@ -332,4 +335,3 @@     it "concur matches notDisjoint"       $          concur (beginerval 1 0) (beginerval 10 (0 :: Int))       `shouldBe` notDisjoint (beginerval 1 0) (beginerval 10 (0 :: Int))-

@@ -0,0 +1,823 @@+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE TypeApplications  #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++-- tag::import-declarations[]+import IntervalAlgebra+import IntervalAlgebra.IntervalDiagram++import Data.Bifunctor ( Bifunctor(..) )+import Data.List ( sort )+import Data.Time+    ( addDays, fromGregorian, secondsToDiffTime, Day, UTCTime(..) )+import Witch ( into )+import Data.Set ( fromList, difference, Set )+-- end::import-declarations[]++main :: IO ()+main = do++  -- Add file header -----------------------------------------------------------++  putStrLn "Generated by running `cabal run tutorial -v0 > tutorial/TutorialMain.out`"+  putStrLn "Do not edit by hand\n\n"+++  -- show Interval examples ----------------------------------------------------++  putStrLn "-- tag::interval-show-print[]"++  putStr "\n-- An example Interval Integer"+  putStr "\nprint ivInteger\n---> "+  print ivInteger++  putStr "\n-- An example Interval Day"+  putStr "\nprint ivDay\n---> "+  print ivDay++  putStr "\n-- An example Interval UTCTime"+  putStr "\nprint ivUTC\n---> "+  print ivUTC++  putStrLn "-- end::interval-show-print[]"+++  -- Basic Interval instances examples ------------------------------------------++  putStrLn "-- tag::interval-basic-instances-print[]"++  putStr "\nprint $ ivInteger == ivInteger\n---> "+  print $ ivInteger == ivInteger++  putStr "\nprint $ ivDay < ivDay\n---> "+  print $ ivDay < ivDay++  putStr "\nprint $ show ivInteger\n---> "+  print $ show ivInteger++  putStrLn "-- end::interval-basic-instances-print[]"+++  -- parseInterval examples ----------------------------------------------------++  putStrLn "-- tag::parseinterval-print[]"++  putStr "\nprint rightIvInteger\n---> "+  print rightIvInteger++  putStr "\nprint leftIvInteger\n---> "+  print leftIvInteger++  putStr "\nprint rightIvDay\n---> "+  print rightIvDay++  putStr "\nprint rightIvUTC\n---> "+  print rightIvUTC++  putStrLn "-- end::parseinterval-print[]"+++  -- safeInterval examples -----------------------------------------------------++  putStrLn "-- tag::safeinterval-print[]"++  putStr "\nprint ivInteger\n---> "+  print ivInteger++  putStr "\nprint ivMinDurInteger\n---> "+  print ivMinDurInteger++  putStr "\nprint ivInteger\n---> "+  print ivInteger++  putStr "\nprint ivDay\n---> "+  print ivDay++  putStr "\nprint ivUTC\n---> "+  print ivUTC++  putStrLn "-- end::safeinterval-print[]"+++  -- beginerval and enderval examples -------------------------------------------------------++  putStrLn "-- tag::beginerval-enderval-print[]"++  putStr "\nprint (beginerval 2 3 :: Interval Integer)\n---> "+  print (beginerval 2 3 :: Interval Integer)++  putStr "\nprint (beginerval (-2) 3 :: Interval Integer)\n---> "+  print (beginerval (-2) 3 :: Interval Integer)++  putStr "\nprint (enderval 2 12 :: Interval Integer)\n---> "+  print (enderval 2 12 :: Interval Integer)++  putStr "\nprint (enderval (-2) 12 :: Interval Integer)\n---> "+  print (enderval (-2) 12 :: Interval Integer)++  putStrLn "-- end::beginerval-enderval-print[]"+++  -- Creating moments examples --------------------------------------------------++  putStrLn "-- tag::creating-moments-print[]"++  putStr "\nprint (beginervalMoment 11 :: Interval Integer)\n---> "+  print (beginervalMoment 11 :: Interval Integer)++  putStr "\nprint (endervalMoment 11 :: Interval Integer)\n---> "+  print (endervalMoment 11 :: Interval Integer)++  putStrLn "-- end::creating-moments-print[]"+++  -- Creating PairedIntervals examples --------------------------------------++  putStrLn "-- tag::creating-pairedinterval-print[]"++  putStr "\nprint pairListstringInteger\n---> "+  print pairListstringInteger++  putStr "\nprint pairStringDay\n---> "+  print pairStringDay++  putStrLn "-- end::creating-pairedinterval-print[]"+++  -- Basic PairedInterval instances examples ------------------------------------++  putStrLn "-- tag::pairedinterval-basic-instances-print[]"++  putStr "\nprint $ pairStringDay == pairStringDay\n---> "+  print $ pairStringDay == pairStringDay++  putStr "\nprint $ pairListstringInteger < pairListstringInteger\n---> "+  print $ pairListstringInteger < pairListstringInteger++  putStr "\nprint $ show pairStringDay\n---> "+  print $ show pairStringDay++  putStrLn "-- end::pairedinterval-basic-instances-print[]"+++  -- Getting/setting PairedInterval intervals example --------------------------++  putStrLn "-- tag::pairedinterval-getset-intervals-print[]"++  putStr "\nprint pairListstringInteger\n---> "+  print pairListstringInteger++  putStr "\nprint $ getInterval pairListstringInteger\n---> "+  print $ getInterval pairListstringInteger++  putStr "\nprint $ setInterval pairListstringInteger (safeInterval (4, 9) :: Interval Integer)\n---> "+  print $ setInterval pairListstringInteger (safeInterval (4, 9) :: Interval Integer)++  putStr "\nprint $ intervals [pairListstringInteger, pairListstringInteger]\n---> "+  print $ intervals [pairListstringInteger, pairListstringInteger]++  putStr "\nprint $ begin pairListstringInteger\n---> "+  print $ begin pairListstringInteger++  putStr "\nprint $ end pairListstringInteger\n---> "+  print $ end pairListstringInteger++  putStrLn "-- end::pairedinterval-getset-intervals-print[]"+++  -- Example getting/setting PairedInterval data -------------------------------++  putStrLn "-- tag::pairedinterval-getset-data-print[]"++  putStr "\nprint pairStringDay\n---> "+  print pairStringDay++  putStr "\nprint $ getPairData pairStringDay\n---> "+  print $ getPairData pairStringDay++  putStr "\nprint $ makePairedInterval \"ski trip\" (getInterval pairStringDay)\n---> "+  print $ makePairedInterval "ski trip" (getInterval pairStringDay)++  putStrLn "-- end::pairedinterval-getset-data-print[]"+++  -- Intervallic interval instance examples ------------------------------------------------------++  putStrLn "-- tag::intervallic-interval-instance-print[]"++  putStr "\nprint ivInteger\n---> "+  print ivInteger++  putStr "\nprint $ getInterval ivInteger\n---> "+  print $ getInterval ivInteger++  putStr "\nprint $ setInterval ivInteger (beginerval 3 12 :: Interval Integer)\n---> "+  print $ setInterval ivInteger (beginerval 3 12 :: Interval Integer)++  putStr "\nprint $ begin ivInteger\n---> "+  print $ begin ivInteger++  putStr "\nprint $ end ivInteger\n---> "+  print $ end ivInteger++  putStrLn "-- end::intervallic-interval-instance-print[]"+++  -- IntervalSizeable instance examples ------------------------------------------------------++  putStrLn "-- tag::intervalsizeable-instance-print[]"++  putStr "\nprint ivDay\n---> "+  print ivDay++  putStr "\nprint $ moment @Day\n---> "+  print $ moment @Day++  putStr "\nprint $ duration ivDay\n---> "+  print $ duration ivDay++  putStr "\nprint $ add 15 (begin ivDay)\n---> "+  print $ add 15 (begin ivDay)++  putStr "\nprint $ diff (add 15 (begin ivDay)) (begin ivDay)\n---> "+  print $ diff (add 15 (begin ivDay)) (begin ivDay)++  putStrLn "-- end::intervalsizeable-instance-print[]"+++  -- IntervalCombineable Interval examples -------------------------------------++  putStrLn "-- tag::intervalcombinable-interval-print[]"++  putStrLn "\n-- The Just Interval formed from combining the Intervals, since iv0to2 `meets` iv2to5"+  putStr "print $ iv0to2 .+. iv2to5\n---> "+  print $ iv0to2 .+. iv2to5++  putStrLn "\n-- A Nothing since iv0to2 doesn't `meets` iv5to8"+  putStr "print $ iv0to2 .+. iv5to8\n---> "+  print $ iv0to2 .+. iv5to8++  putStrLn "\n-- The Just Interval formed from the end of the first and the beginning of the\n-- second, since iv0to2 is `before` iv5to8"+  putStr "print $ iv0to2 >< iv5to8\n---> "+  print $ iv0to2 >< iv5to8++  putStrLn "\n-- A Nothing since iv0to2 isn't `before` iv2to5"+  putStr "print $ iv0to2 >< iv2to5\n---> "+  print $ iv0to2 >< iv2to5++  putStrLn "-- end::intervalcombinable-interval-print[]"+++  -- IntervalCombineable PairedInterval examples -------------------------------++  putStrLn "-- tag::intervalcombinable-pairedinterval-print[]"++  putStrLn "\n-- The Just Interval formed from combining the Intervals and taking the data\n-- portion from the second argument, since iv0to2 `meets` iv2to5"+  putStr "print $ makePairedInterval \"a\" iv0to2 .+. makePairedInterval \"b\" iv2to5\n---> "+  print $ makePairedInterval "a" iv0to2 .+. makePairedInterval "b" iv2to5++  putStrLn "\n-- A Nothing since iv0to2 doesn't `meets` iv5to8"+  putStr "print $ makePairedInterval \"a\" iv0to2 .+. makePairedInterval \"b\" iv5to8\n---> "+  print $ makePairedInterval "a" iv0to2 .+. makePairedInterval "b" iv5to8++  putStrLn "\n-- The Just Interval formed from spanning the Intervals and taking the data\n-- portion from the `mempty` method of the Monoid String instance, since\n-- iv0to2 is `before` iv5to8"+  putStr "print $ makePairedInterval \"a\" iv0to2 >< makePairedInterval \"b\" iv5to8\n---> "+  print $ makePairedInterval "a" iv0to2 >< makePairedInterval "b" iv5to8++  putStrLn "\n-- A Nothing since iv0to2 isn't `before` iv2to5"+  putStr "print $ makePairedInterval \"a\" iv0to2 >< makePairedInterval \"b\" iv2to5\n---> "+  print $ makePairedInterval "a" iv0to2 >< makePairedInterval "b" iv2to5++  putStrLn "-- end::intervalcombinable-pairedinterval-print[]"+++  -- Expanding intervals examples -----------------------------------------------++  putStrLn "-- tag::expanding-intervals-print[]"++  putStr "\nprint ivInteger\n---> "+  print ivInteger++  putStr "\nprint $ expandl 4 ivInteger\n---> "+  print $ expandl 4 ivInteger++  putStr "\nprint $ expandl 0 ivInteger\n---> "+  print $ expandl 0 ivInteger++  putStr "\nprint $ expandr 5 ivInteger\n---> "+  print $ expandr 5 ivInteger++  putStr "\nprint $ expandr (-3) ivInteger\n---> "+  print $ expandr (-3) ivInteger++  putStr "\nprint $ expand 4 5 ivInteger\n---> "+  print $ expand 4 5 ivInteger++  putStr "\nprint $ expand 0 (-3) ivInteger\n---> "+  print $ expand 0 (-3) ivInteger++  putStrLn "-- end::expanding-intervals-print[]"+++  -- Sharing an endpoint interval examples -----------------------------------------------++  putStrLn "-- tag::sharing-endpoint-interval-print[]"++  putStr "\nprint ivInteger\n---> "+  print ivInteger++  putStr "\nbeginervalFromEnd 5 ivInteger\n---> "+  print $ beginervalFromEnd 5 ivInteger++  putStr "\nbeginervalFromEnd (-2) ivInteger\n---> "+  print $ beginervalFromEnd (-2) ivInteger++  putStr "\nendervalFromBegin 12 ivInteger\n---> "+  print $ endervalFromBegin 12 ivInteger++  putStr "\nendervalFromBegin (-6) ivInteger\n---> "+  print $ endervalFromBegin (-6) ivInteger++  putStr "\nprint $ momentize ivInteger\n---> "+  print $ momentize ivInteger++  putStrLn "-- end::sharing-endpoint-interval-print[]"+++  -- Example shifting intervals -----------------------------------------------++  putStrLn "-- tag::shifting-intervals-print[]"++  putStr "\nprint [iv2to4, iv5to8]\n---> "+  print [iv2to4, iv5to8]++  putStr "\nprint ivDay\n---> "+  print ivDay++  putStr "\nprint $ shiftFromBegin iv2to4 iv5to8\n---> "+  print $ shiftFromBegin iv2to4 iv5to8++  putStr "\nprint $ shiftFromBegin ivDay ivDay\n---> "+  print $ shiftFromBegin ivDay ivDay++  putStr "\nprint $ shiftFromEnd iv2to4 iv5to8\n---> "+  print $ shiftFromEnd iv2to4 iv5to8++  putStr "\nprint $ shiftFromEnd ivDay ivDay\n---> "+  print $ shiftFromEnd ivDay ivDay++  putStrLn "-- end::shifting-intervals-print[]"+++  -- Relations variables diagram example --------------------------------------------++  putStrLn "-- tag::relations-variables-diagram-print[]"++  print $ pretty diagr++  putStrLn "-- end::relations-variables-diagram-print[]"+++  -- Composing relations examples -------------------------------------------++  putStrLn "-- tag::composing-relations-print[]"++  putStr "\nprint endedPriorRelations\n---> "+  print endedPriorRelations++  putStr "\nprint notEndedPriorRelations\n---> "+  print notEndedPriorRelations++  putStr "\nprint notEndedPriorRelations'\n---> "+  print notEndedPriorRelations'++  putStr "\nprint intervalRelations'\n---> "+  print intervalRelations'++  putStr "\nprint empty\n---> "+  print empty++  putStrLn "-- end::composing-relations-print[]"+++  -- Composing predicates v1 examples ---------------------------------------++  putStrLn "-- tag::composing-predicates-1-print[]"++  putStr "\nprint $ iv0to2 `precedes` iv3to6"+  putStr "\nprint $ iv0to2 `meets` iv3to6"+  putStr "\nprint $ iv0to2 `endedPrior` iv3to6\n---> "+  print $ iv0to2 `precedes` iv3to6+  putStr "---> "+  print $ iv0to2 `meets` iv3to6+  putStr "---> "+  print $ iv0to2 `endedPrior` iv3to6++  putStrLn "-- end::composing-predicates-1-print[]"+++  -- Composing predicates v2 examples ---------------------------------------++  putStrLn "-- tag::composing-predicates-2-print[]"++  putStr "\nprint $ iv0to2 `precedes` iv2to4"+  putStr "\nprint $ iv0to2 `meets` iv2to4"+  putStr "\nprint $ iv0to2 `endedPrior` iv2to4\n---> "+  print $ iv0to2 `precedes` iv2to4+  putStr "---> "+  print $ iv0to2 `meets` iv2to4+  putStr "---> "+  print $ iv0to2 `endedPrior` iv2to4++  putStrLn "-- end::composing-predicates-2-print[]"+++  -- Composing predicates v3 examples ---------------------------------------++  putStrLn "-- tag::composing-predicates-3-print[]"++  putStr "\nprint $ iv5to8 `precedes` iv2to4"+  putStr "\nprint $ iv5to8 `meets` iv2to4"+  putStr "\nprint $ iv5to8 `endedPrior` iv2to4\n---> "+  print $ iv5to8 `precedes` iv2to4+  putStr "---> "+  print $ iv5to8 `meets` iv2to4+  putStr "---> "+  print $ iv5to8 `endedPrior` iv2to4++  putStrLn "-- end::composing-predicates-3-print[]"+++  -- Extended example 1 examples --------------------------------------------------------++  putStrLn "-- tag::extended-example-1-print[]"++  putStr "\nprint $ head results\n---> "+  print $ head results++  putStr "\nprint $ results !! 1\n---> "+  print $ results !! 1++  putStr "\nprint $ results !! 2\n---> "+  print $ results !! 2++  putStr "\nprint $ results !! 3\n---> "+  print $ results !! 3++  putStrLn "-- end::extended-example-1-print[]"+++-- tag::parseinterval-examples[]+rightIvInteger :: Either ParseErrorInterval (Interval Integer)+rightIvInteger = parseInterval 0 2++leftIvInteger :: Either ParseErrorInterval (Interval Integer)+leftIvInteger = parseInterval 2 2++rightIvDay :: Either ParseErrorInterval (Interval Day)+rightIvDay =+  parseInterval (fromGregorian 1967 01 18) (fromGregorian 1967 01 22)++rightIvUTC :: Either ParseErrorInterval (Interval UTCTime)+rightIvUTC = parseInterval+  (UTCTime (fromGregorian 1967 01 18) (secondsToDiffTime 32400))+  (UTCTime (fromGregorian 1967 01 18) (secondsToDiffTime 33200))+-- end::parseinterval-examples[]+++-- tag::safeinterval-examples[]+ivInteger :: Interval Integer+ivInteger = safeInterval (2, 6)++ivMinDurInteger :: Interval Integer+ivMinDurInteger = safeInterval (2, 2)++ivDay :: Interval Day+ivDay = safeInterval (fromGregorian 1967 01 18, fromGregorian 1967 01 24)++ivUTC :: Interval UTCTime+ivUTC = safeInterval+  ( UTCTime (fromGregorian 1967 01 18) (secondsToDiffTime 32400)+  , UTCTime (fromGregorian 1967 01 18) (secondsToDiffTime 33200)+  )+-- end::safeinterval-examples[]+++-- tag::ivXtoY-examples[] ----------------++iv0to2, iv2to4, iv2to5, iv4to5, iv5to8, iv6to8, iv3to6 :: Interval Integer+iv0to2 = safeInterval (0, 2)+iv2to4 = safeInterval (2, 4)+iv2to5 = safeInterval (2, 5)+iv3to6 = safeInterval (3, 6)+iv4to5 = safeInterval (4, 5)+iv5to8 = safeInterval (5, 8)+iv6to8 = safeInterval (6, 8)++-- end::ivXtoY-examples[]+++-- tag::creating-pairedinterval-examples[] --------------------++pairListstringInteger :: PairedInterval [String] Integer+pairListstringInteger =+  makePairedInterval ["John", "Paul", "George", "Ringo"] ivInteger++pairStringDay :: PairedInterval String Day+pairStringDay = makePairedInterval "vacation" ivDay++-- end::creating-pairedinterval-examples[]+++-- tag::composing-relations-examples[]++-- Set, `fromList`, and in a later example `difference` are imported from+-- Data.Set+endedPriorRelations :: Set IntervalRelation+endedPriorRelations = fromList [Before, Meets]++-- We can in general create a new Set by taking the set Difference of one Set+-- and another Set+notEndedPriorRelations :: Set IntervalRelation+notEndedPriorRelations = intervalRelations `difference` endedPriorRelations++-- However, the `complement` function is provided for the common case of taking+-- the Set Difference of the `intervalRelations` Set and another Set+notEndedPriorRelations' :: Set IntervalRelation+notEndedPriorRelations' = complement endedPriorRelations++-- IntervalAlgebra exports versions of `Data.Set`s `intersection` and `union`+-- functions where the types are specialized to `Set IntervalRelation`s+intervalRelations' :: Set IntervalRelation+intervalRelations' = endedPriorRelations `union` notEndedPriorRelations++-- The intersection of two disjoint sets+empty :: Set IntervalRelation+empty = endedPriorRelations `intersection` notEndedPriorRelations++-- end::composing-relations-examples[]+++-- tag::composing-predicates-examples[] -----------------------++-- We can construct a predicate function from a 'Set IntervalRelation'+endedPrior+  :: (Ord a, Intervallic i0, Intervallic i1)+  => ComparativePredicateOf2 (i0 a) (i1 a)+endedPrior = predicate (fromList [Before, Meets])++-- We can also construct a predicate function directly from a list of predicate+-- functions+endedPrior'+  :: (Ord a, Intervallic i0, Intervallic i1)+  => ComparativePredicateOf2 (i0 a) (i1 a)+endedPrior' = unionPredicates [before, meets]++-- As an alternative to `unionPredicates` we can compose predicate functions+-- using the <|> operator. If we had multiple predicates we could use e.g.:+--     p1 <|> p2 <|> p3+endedPrior''+  :: (Ord a, Intervallic i0, Intervallic i1)+  => ComparativePredicateOf2 (i0 a) (i1 a)+endedPrior'' = before <|> meets++-- end::composing-predicates-examples[]+++-- tag::extended-example-1-types[] --------------------++data DataType = Enrollment | Treatment TreatmentType | Diagnosis DiagnosisType+  deriving (Eq, Ord, Show)++data TreatmentType = StandardVaccine | NewVaccine+  deriving (Eq, Ord, Show)++data DiagnosisType = RightAsRain | UpsetTummy | CommonCold | Flu+  deriving (Eq, Ord, Show)++type StudyEvent = PairedInterval DataType Integer++type SubjEvents = [StudyEvent]++data ProcessedSubj = ProcessedSubj+  { getEnrollment   :: Maybe (Interval Integer)+  , getFirstTrt     :: Maybe StudyEvent+  , getFirstFlu     :: Maybe StudyEvent+  , getTrtType      :: Maybe TreatmentType+  , getTimeToFlu    :: Maybe Integer+  , getTimeToEndEnr :: Maybe Integer+  }+  deriving Show++maxEnrGap :: Integer+maxEnrGap = 8++-- end::extended-example-1-types[]+++-- tag::extended-example-1-study-data-subj-1[] ----------------++id1Event1, id1Event2, id1Event3, id1Event4, id1Event5, id1Event6, id1Event7+  :: StudyEvent+id1Event1 = makePairedInterval Enrollment (safeInterval (6, 191))+id1Event2 = makePairedInterval Enrollment (safeInterval (199, 345))+id1Event3 = makePairedInterval Enrollment (safeInterval (347, 422))+id1Event4 = makePairedInterval (Diagnosis RightAsRain) (safeInterval (12, 13))+id1Event5 = makePairedInterval (Treatment NewVaccine) (safeInterval (22, 23))+id1Event6 = makePairedInterval (Diagnosis RightAsRain) (safeInterval (131, 132))+id1Event7 = makePairedInterval (Diagnosis CommonCold) (safeInterval (161, 162))++id1Events :: SubjEvents+id1Events = sort+  [id1Event1, id1Event2, id1Event3, id1Event4, id1Event5, id1Event6, id1Event7]++-- end::extended-example-1-study-data-subj-1[]+++-- tag::extended-example-1-study-data-subj-2[] ----------------++id2Event1, id2Event2, id2Event3, id2Event4, id2Event5, id2Event6, id2Event7, id2Event8+  :: StudyEvent+id2Event1 = makePairedInterval Enrollment (safeInterval (2, 206))+id2Event2 = makePairedInterval Enrollment (safeInterval (222, 299))+id2Event3 = makePairedInterval Enrollment (safeInterval (304, 486))+id2Event4 = makePairedInterval (Diagnosis RightAsRain) (safeInterval (4, 5))+id2Event5 =+  makePairedInterval (Treatment StandardVaccine) (safeInterval (98, 99))+id2Event6 = makePairedInterval (Diagnosis CommonCold) (safeInterval (161, 162))+id2Event7 = makePairedInterval (Diagnosis UpsetTummy) (safeInterval (191, 192))+id2Event8 = makePairedInterval (Diagnosis Flu) (safeInterval (255, 256))++id2Events :: SubjEvents+id2Events = sort+  [ id2Event1, id2Event2, id2Event3, id2Event4, id2Event5 , id2Event6+  , id2Event7, id2Event8 ]++-- end::extended-example-1-study-data-subj-2[]+++-- tag::extended-example-1-study-data-subj-3[] ----------------++id3Event1, id3Event2, id3Event3 :: StudyEvent+id3Event1 = makePairedInterval Enrollment (safeInterval (7, 197))+id3Event2 = makePairedInterval (Treatment StandardVaccine) (safeInterval (19, 20))+id3Event3 = makePairedInterval (Diagnosis Flu) (safeInterval (180, 181))++id3Events :: SubjEvents+id3Events = sort [id3Event1, id3Event2, id3Event3]++-- end::extended-example-1-study-data-subj-3[]+++-- tag::extended-example-1-study-data-subj-4[] ----------------++id4Event1, id4Event2 :: StudyEvent+id4Event1 = makePairedInterval Enrollment (safeInterval (3, 89))+id4Event2 = makePairedInterval (Diagnosis RightAsRain) (safeInterval (47, 48))++id4Events :: SubjEvents+id4Events = sort [id4Event1, id4Event2]++-- end::extended-example-1-study-data-subj-4[]+++-- tag::extended-example-1-processing-functions[] -------------++-- Construct the elements of a `ProcessedSubj` one step at-a-time. Most of the+-- actual work is done by the helper functions defined below+processSubj :: SubjEvents -> ProcessedSubj+processSubj xs =+  let enrPeriod    = calcEnrPeriod xs                   -- enrollment period+      enrEvents    = calcEnrEvents enrPeriod xs         -- events within enrollment+      firstTrt     = findFirstTrt enrPeriod xs          -- first treatment in enr+      firstTrtType = extractTrtType firstTrt            -- first trt type+      firstTrtIv   = fmap getInterval firstTrt          -- first trt interval+      firstFlu     = findFirstFlu firstTrtIv enrEvents  -- first flu in enr+      ttFlu        = calcDiff firstFlu firstTrt         -- time to first flu+      ttEndEnr     = calcAtRisk enrPeriod firstTrt      -- time to end of enr+  in  ProcessedSubj enrPeriod firstTrt firstFlu firstTrtType ttFlu ttEndEnr++-- Construct the "enrollment period", which is defined at the period of time+-- with the start endpoint given by their earliest enrollment period and end+-- endpoint given by the first time that they fall out of the grace period. In+-- the event that a subject did not have any enrollment periods then the return+-- value is a Nothing.+--+-- Note that this function uses the `combineIntervals` function which was not+-- covered in this tutorial, but is exported from IntervalAlgebra via+-- IntervalAlgebra.IntervalUtilities.+calcEnrPeriod :: SubjEvents -> Maybe (Interval Integer)+calcEnrPeriod xs | null combinedPeriods = Nothing+                 | otherwise            = Just (head combinedPeriods)+  where combinedPeriods = (combineIntervals . addMaxEnrGap . extractEnrIvs) xs++-- Filter the enrollment events in the SubjEvents and extract the Interval+-- from each one+extractEnrIvs :: SubjEvents -> [Interval Integer]+extractEnrIvs = intervals . filter (checkEnr . getPairData)+ where+  checkEnr Enrollment = True+  checkEnr _          = False++-- Extend the end endpoint for each Interval by `maxEnrGap`+addMaxEnrGap :: [Interval Integer] -> [Interval Integer]+addMaxEnrGap = map (expandr maxEnrGap)++-- Filter the SubjEvents to those with endpoints that do not extend past the+-- enrollment period's endpoints+calcEnrEvents :: Maybe (Interval Integer) -> SubjEvents -> SubjEvents+calcEnrEvents mayIv xs = case mayIv of+  Nothing -> []+  Just y  -> filter (\x -> getInterval x `enclosedBy` y) xs++-- Find the first flu vaccine administrations occuring within the enrollment+-- period+findFirstTrt :: Maybe (Interval Integer) -> SubjEvents -> Maybe StudyEvent+findFirstTrt Nothing _ = Nothing+findFirstTrt (Just iv) xs | null filteredIntakes = Nothing+                          | otherwise            = Just (head filteredIntakes)+ where+  p x = checkTrt (getPairData x) && (getInterval x `enclosedBy` iv)+  checkTrt (Treatment _) = True+  checkTrt _             = False+  filteredIntakes = filter p xs++-- Extract the treatment type out of a StudyEvent. If there is no event or the+-- StudyEvent type isn't TreatmentType then return Nothing+extractTrtType :: Maybe StudyEvent -> Maybe TreatmentType+extractTrtType Nothing  = Nothing+extractTrtType (Just x) = case getPairData x of+  Treatment StandardVaccine -> Just StandardVaccine+  Treatment NewVaccine      -> Just NewVaccine+  _                         -> Nothing++-- Find the first flu diagnosis occuring within the enrollment period+findFirstFlu :: Maybe (Interval Integer) -> SubjEvents -> Maybe StudyEvent+findFirstFlu Nothing _ = Nothing+findFirstFlu (Just iv) xs | null filteredFlus = Nothing+                          | otherwise         = Just (head filteredFlus)+ where+  endedPrior = before <|> meets+  p x = checkDiagFlu (getPairData x) && (iv `endedPrior` getInterval x)+  checkDiagFlu (Diagnosis Flu) = True+  checkDiagFlu _               = False+  filteredFlus = filter p xs++-- Calculate the difference between the start endpoint of the first Intervallic+-- and the start endpoint of the second Intervallic+calcDiff+  :: (IntervalSizeable a b, Intervallic i0, Intervallic i1)+  => Maybe (i0 a)+  -> Maybe (i1 a)+  -> Maybe b+calcDiff (Just y) (Just x) = Just $ diff (begin y) (end x)+calcDiff _ _               = Nothing++-- Calculate the difference between the end endpoint of the first Intervallic+-- and the start endpoint of the second Intervallic+calcAtRisk+  :: (IntervalSizeable a b, Intervallic i0, Intervallic i1)+  => Maybe (i0 a)+  -> Maybe (i1 a)+  -> Maybe b+calcAtRisk (Just y) (Just x) = Just $ diff (end y) (end x)+calcAtRisk _ _               = Nothing++-- end::extended-example-1-processing-functions[]+++-- tag::extended-example-1-calculate-results[] ----------------++results :: [ProcessedSubj]+results = map processSubj [id1Events, id2Events, id3Events, id4Events]++-- end::extended-example-1-calculate-results[]+++--------------------------------------------------------------------------------+-- The remaining is untagged data+--------------------------------------------------------------------------------++diagr :: Either IntervalDiagramParseError (IntervalDiagram Integer)+diagr = parseIntervalDiagram+  defaultIntervalDiagramOptions+  []+  (Just Bottom)+  (into @(IntervalText Integer) ('=', safeInterval (0, 12 :: Integer)))+  [ ([deftIT iv0to2], ["iv0to2"])+  , ([deftIT iv2to4], ["iv2to4"])+  , ([deftIT iv2to5], ["iv2to5"])+  , ([deftIT iv3to6], ["iv3to6"])+  , ([deftIT iv4to5], ["iv4to5"])+  , ([deftIT iv6to8], ["iv6to8"])+  , ([deftIT iv5to8], ["iv5to8"])+  ]++intoIntervalText :: Interval Integer -> IntervalText Integer+intoIntervalText x = into @(IntervalText Integer) ('-', x)++deftIT :: Interval Integer -> IntervalText Integer+deftIT = intoIntervalText