interval-algebra 2.1.1 → 2.1.2
raw patch · 16 files changed
+471/−715 lines, 16 filesdep −nonempty-containersPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: nonempty-containers
API changes (from Hackage documentation)
- IntervalAlgebra.Axioms: instance IntervalAlgebra.Axioms.IntervalAxioms Data.Time.Calendar.Days.Day GHC.Integer.Type.Integer
- IntervalAlgebra.Core: instance IntervalAlgebra.Core.IntervalSizeable Data.Time.Calendar.Days.Day GHC.Integer.Type.Integer
- IntervalAlgebra.Core: instance IntervalAlgebra.Core.IntervalSizeable GHC.Integer.Type.Integer GHC.Integer.Type.Integer
- IntervalAlgebra.IntervalDiagram: instance Witch.From.From (GHC.Types.Char, IntervalAlgebra.Core.Interval a) (IntervalAlgebra.IntervalDiagram.IntervalText a)
- IntervalAlgebra.IntervalDiagram: instance Witch.From.From (IntervalAlgebra.IntervalDiagram.IntervalText a) (IntervalAlgebra.Core.Interval a)
- IntervalAlgebra.IntervalDiagram: instance Witch.From.From (IntervalAlgebra.IntervalDiagram.IntervalText a) GHC.Types.Char
- IntervalAlgebra.RelationProperties: instance IntervalAlgebra.RelationProperties.IntervalRelationProperties Data.Time.Calendar.Days.Day GHC.Integer.Type.Integer
+ IntervalAlgebra.Axioms: instance IntervalAlgebra.Axioms.IntervalAxioms Data.Time.Calendar.Days.Day GHC.Num.Integer.Integer
+ IntervalAlgebra.Core: instance IntervalAlgebra.Core.IntervalSizeable Data.Time.Calendar.Days.Day GHC.Num.Integer.Integer
+ IntervalAlgebra.Core: instance IntervalAlgebra.Core.IntervalSizeable GHC.Num.Integer.Integer GHC.Num.Integer.Integer
+ IntervalAlgebra.RelationProperties: instance IntervalAlgebra.RelationProperties.IntervalRelationProperties Data.Time.Calendar.Days.Day GHC.Num.Integer.Integer
Files
- ChangeLog.md +6/−0
- interval-algebra.cabal +1/−2
- src/IntervalAlgebra.hs +6/−5
- src/IntervalAlgebra/Arbitrary.hs +26/−55
- src/IntervalAlgebra/Axioms.hs +27/−40
- src/IntervalAlgebra/Core.hs +31/−85
- src/IntervalAlgebra/IntervalDiagram.hs +76/−86
- src/IntervalAlgebra/IntervalUtilities.hs +100/−154
- src/IntervalAlgebra/PairedInterval.hs +15/−20
- src/IntervalAlgebra/RelationProperties.hs +11/−24
- test-axioms/AxiomsSpec.hs +10/−20
- test-relation-properties/RelationPropertiesSpec.hs +6/−12
- test/IntervalAlgebra/IntervalUtilitiesSpec.hs +61/−98
- test/IntervalAlgebra/PairedIntervalSpec.hs +10/−21
- test/IntervalAlgebraSpec.hs +22/−46
- tutorial/TutorialMain.hs +63/−47
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for interval-algebra +## 2.1.2++* Exports `IntervalAlgebra.IntervalDiagram` module and makes the following changes so as to export it as `safe`:+ * Removes `nonempty-containers` dependency and `Data.IntMap.NonEmpty` usage in `IntervalAlgebra.IntervalDiagram`. Replaces the non-empty `IntMap` with a key-value pair in a non-empty list.+ * Removes `From` instances, which were unnecessary.+ ## 2.1.1 * Makes the version bounds on the `time` package
interval-algebra.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: interval-algebra-version: 2.1.1+version: 2.1.2 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@@ -42,7 +42,6 @@ , containers ^>= 0.6 , deepseq >= 1.1 && < 1.5 , foldl ^>= 1.4- , nonempty-containers ^>= 0.3 , prettyprinter ^>= 1.7 , QuickCheck ^>= 2.14 , safe ^>= 0.3
src/IntervalAlgebra.hs view
@@ -5,9 +5,9 @@ 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). This main module reexports @IntervalAlgebra.Core@, @IntervalAlgebra.IntervalUtilities@,@@ -23,6 +23,7 @@ , module IntervalAlgebra.PairedInterval ) where -import safe IntervalAlgebra.Core-import safe IntervalAlgebra.IntervalUtilities-import safe IntervalAlgebra.PairedInterval+import safe IntervalAlgebra.Core+import safe IntervalAlgebra.IntervalDiagram+import safe IntervalAlgebra.IntervalUtilities+import safe IntervalAlgebra.PairedInterval
src/IntervalAlgebra/Arbitrary.hs view
@@ -6,74 +6,45 @@ Maintainer : bsaul@novisci.com Stability : experimental -}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module IntervalAlgebra.Arbitrary ( arbitraryWithRelation ) where -import Control.Applicative ( (<$>)- , liftA2- )-import Control.Monad ( liftM2 )+import Control.Applicative (liftA2, (<$>))+import Control.Monad (liftM2) import Data.Bool import Data.Fixed-import Data.Function ( ($)- , (.)- , flip- )-import Data.Maybe ( Maybe(Just, Nothing) )+import Data.Function (flip, ($), (.))+import Data.Maybe (Maybe (Just, Nothing)) import Data.Ord-import qualified Data.Set ( Set- , difference- , null- , singleton- )-import Data.Time as DT- ( Day(ModifiedJulianDay)- , DiffTime- , NominalDiffTime- , UTCTime(..)- , picosecondsToDiffTime- , secondsToDiffTime- , secondsToNominalDiffTime- , toModifiedJulianDay- )+import qualified Data.Set (Set, difference, null, singleton)+import Data.Time as DT (Day (ModifiedJulianDay), DiffTime,+ NominalDiffTime, UTCTime (..),+ picosecondsToDiffTime,+ secondsToDiffTime,+ secondsToNominalDiffTime,+ toModifiedJulianDay) import GHC.Float-import GHC.Int ( Int )+import GHC.Int (Int) import GHC.Num import GHC.Real-import IntervalAlgebra ( Interval- , IntervalRelation(..)- , IntervalSizeable- , Intervallic- , PairedInterval- , beginerval- , converse- , duration- , makePairedInterval- , moment- , predicate- , strictWithinRelations- )-import Prelude ( (==)- , Eq- )-import Test.QuickCheck ( Arbitrary(arbitrary, shrink)- , Gen- , NonNegative- , arbitrarySizedNatural- , elements- , resize- , sized- , suchThat- )+import IntervalAlgebra (Interval, IntervalRelation (..),+ IntervalSizeable, Intervallic,+ PairedInterval, beginerval, converse,+ duration, makePairedInterval, moment,+ predicate, strictWithinRelations)+import Prelude (Eq, (==))+import Test.QuickCheck (Arbitrary (arbitrary, shrink), Gen,+ NonNegative, arbitrarySizedNatural,+ elements, resize, sized, suchThat) -- NOTE: the default size for arbitrary :: Gen Int appears to be 30 arbitrarySizedPositive :: Integral a => Gen a
src/IntervalAlgebra/Axioms.hs view
@@ -6,7 +6,7 @@ License : BSD3 Maintainer : bsaul@novisci.com -This module exports a single typeclass @IntervalAxioms@ which contains +This module exports a single typeclass @IntervalAxioms@ which contains property-based tests for the axioms in section 1 of [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x). The notation below is that of the original paper. @@ -14,7 +14,7 @@ -} -{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -25,29 +25,16 @@ , M5set(..) ) where -import Data.Either ( isRight )-import Data.Maybe ( fromJust- , isJust- , isNothing- )-import Data.Set ( Set- , disjointUnion- , fromList- , member- )-import Data.Time as DT- ( Day(..)- , DiffTime- , NominalDiffTime- , UTCTime(..)- )+import Data.Either (isRight)+import Data.Maybe (fromJust, isJust, isNothing)+import Data.Set (Set, disjointUnion, fromList,+ member)+import Data.Time as DT (Day (..), DiffTime,+ NominalDiffTime, UTCTime (..)) import IntervalAlgebra.Arbitrary import IntervalAlgebra.Core-import Test.QuickCheck ( (===)- , (==>)- , Arbitrary(arbitrary)- , Property- )+import Test.QuickCheck (Arbitrary (arbitrary), Property,+ (===), (==>)) xor :: Bool -> Bool -> Bool@@ -161,12 +148,12 @@ == Axiom M1 The first axiom of Allen and Hayes (1987) states that if "two periods both- meet a third, thn any period met by one must also be met by the other." + meet a third, thn any period met by one must also be met by the other." That is: \[ \forall \text{ i,j,k,l } s.t. (i:j \text{ & } i:k \text{ & } l:j) \implies l:k- \] + \] -} prop_IAaxiomM1 :: (Ord a) => M1set a -> Property prop_IAaxiomM1 x =@@ -188,21 +175,21 @@ == Axiom M2 - If period i meets period j and period k meets l, + If period i meets period j and period k meets l, then exactly one of the following holds: - 1) i meets l; - 2) there is an m such that i meets m and m meets l; + 1) i meets l;+ 2) there is an m such that i meets m and m meets l; 3) there is an n such that k meets n and n meets j.- + That is, \[- \forall i,j,k,l s.t. (i:j \text { & } k:l) \implies - i:l \oplus + \forall i,j,k,l s.t. (i:j \text { & } k:l) \implies+ i:l \oplus (\exists m s.t. i:m:l) \oplus- (\exists m s.t. k:m:j) - \] + (\exists m s.t. k:m:j)+ \] -} @@ -228,7 +215,7 @@ \[ \forall i \lnot i:i- \] + \] -} prop_IAaxiomML1 :: (Ord a) => Interval a -> Property@@ -242,7 +229,7 @@ \[ \forall i,j i:j \implies \lnot j:i- \] + \] -} prop_IAaxiomML2 :: (Ord a)=> M2set a -> Property@@ -259,7 +246,7 @@ \[ \forall i \exists j,k s.t. j:i:k- \] + \] -} prop_IAaxiomM3 :: (IntervalSizeable a b)=>@@ -282,8 +269,8 @@ If two meets are separated by intervals, then this sequence is a longer interval. \[- \forall i,j i:j \implies (\exists k,m,n s.t m:i:j:n \text { & } m:k:n) - \] + \forall i,j i:j \implies (\exists k,m,n s.t m:i:j:n \text { & } m:k:n)+ \] -} prop_IAaxiomM4 :: (IntervalSizeable a b)=>@@ -314,7 +301,7 @@ \[ \forall i,j,k,l (i:j:l \text{ & } i:k:l) \equiv j = k- \] + \] -} prop_IAaxiomM5 :: (IntervalSizeable a b) => M5set a -> Property@@ -335,7 +322,7 @@ \[ \forall i,j i:j \implies (\exists m,n s.t. m:i:j:n \text{ & } m:(i+j):n)- \] + \] -} prop_IAaxiomM4_1 :: (IntervalSizeable a b)=> b -> M2set a -> Property
src/IntervalAlgebra/Core.hs view
@@ -24,14 +24,14 @@ -} -{-# LANGUAGE Safe #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module IntervalAlgebra.Core (@@ -120,84 +120,30 @@ , IntervalSizeable(..) ) where -import Control.Applicative ( Applicative(pure)- , liftA2- )-import Control.DeepSeq ( NFData )-import Data.Binary ( Binary )-import Data.Fixed ( Pico )-import Data.Function ( ($)- , (.)- , flip- , id- )-import Data.Ord ( Ord(..)- , Ordering(..)- , max- , min- )-import Data.Semigroup ( Semigroup((<>)) )-import qualified Data.Set ( Set- , difference- , fromList- , intersection- , map- , toList- , union- )-import Data.Time as DT- ( Day- , DiffTime- , NominalDiffTime- , UTCTime- , addDays- , addUTCTime- , diffDays- , diffUTCTime- , nominalDiffTimeToSeconds- , secondsToNominalDiffTime- )-import Data.Tuple ( fst- , snd- )-import GHC.Generics ( Generic )-import Prelude ( (!!)- , (&&)- , (+)- , (++)- , (-)- , (==)- , Bool(..)- , Bounded(..)- , Either(..)- , Enum(..)- , Eq- , Int- , Integer- , Maybe(..)- , Num- , Rational- , Show- , String- , any- , curry- , fromInteger- , fromRational- , map- , negate- , not- , otherwise- , realToFrac- , replicate- , show- , toInteger- , toRational- )-import Test.QuickCheck ( Arbitrary(..)- , resize- , sized- , suchThat- )+import Control.Applicative (Applicative (pure), liftA2)+import Control.DeepSeq (NFData)+import Data.Binary (Binary)+import Data.Fixed (Pico)+import Data.Function (flip, id, ($), (.))+import Data.Ord (Ord (..), Ordering (..), max, min)+import Data.Semigroup (Semigroup ((<>)))+import qualified Data.Set (Set, difference, fromList, intersection,+ map, toList, union)+import Data.Time as DT (Day, DiffTime, NominalDiffTime,+ UTCTime, addDays, addUTCTime,+ diffDays, diffUTCTime,+ nominalDiffTimeToSeconds,+ secondsToNominalDiffTime)+import Data.Tuple (fst, snd)+import GHC.Generics (Generic)+import Prelude (Bool (..), Bounded (..), Either (..),+ Enum (..), Eq, Int, Integer, Maybe (..),+ Num, Rational, Show, String, any, curry,+ fromInteger, fromRational, map, negate,+ not, otherwise, realToFrac, replicate,+ show, toInteger, toRational, (!!), (&&),+ (+), (++), (-), (==))+import Test.QuickCheck (Arbitrary (..), resize, sized, suchThat) {- $setup >>> import IntervalAlgebra.IntervalDiagram
src/IntervalAlgebra/IntervalDiagram.hs view
@@ -5,23 +5,23 @@ >>> let ref = bi 30 (0 :: Int) >>> let ivs = [ bi 2 0, bi 5 10, bi 6 16 ]->>> pretty $ simpleIntervalDiagram ref ivs --- - ----- - ------ +>>> pretty $ simpleIntervalDiagram ref ivs+--+ -----+ ------ ============================== >>> 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 --- - ----- +>>> pretty $ simpleIntervalDiagram ref ivs+--+ ----- ============================== Such diagrams are useful for documentation, examples, and learning to reason with the interval algebra. -There are two main functions available: +There are two main functions available: * @'parseIntervalDiagram'@: exposes all available options@@ -29,15 +29,15 @@ * @'simpleIntervalDiagram'@ produces simple diagram using defaults. -}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UndecidableInstances #-} module IntervalAlgebra.IntervalDiagram (@@ -69,27 +69,15 @@ , Prettyprinter.Pretty(..) ) where -import Data.Foldable ( Foldable(toList) )-import qualified Data.IntMap.NonEmpty as NEM-import qualified Data.List.NonEmpty as NE- hiding ( toList )-import Data.Maybe ( fromMaybe- , isNothing- )-import Data.Text ( Text- , pack- )+import Data.Foldable (Foldable (toList))+import qualified Data.List.NonEmpty as NE hiding (toList)+import Data.Maybe (fromMaybe, isNothing)+import Data.Text (Text, pack) import IntervalAlgebra.Core-import IntervalAlgebra.IntervalUtilities- ( rangeInterval )-import IntervalAlgebra.PairedInterval ( PairedInterval- , getPairData- , makePairedInterval- )+import IntervalAlgebra.IntervalUtilities (rangeInterval)+import IntervalAlgebra.PairedInterval (PairedInterval, getPairData,+ makePairedInterval) import Prettyprinter-import Witch ( From(..)- , into- ) -- $setup -- >>> :set -XTypeApplications -XFlexibleContexts -XOverloadedStrings@@ -115,10 +103,6 @@ which contains an @Interval a@ and the @Char@ used to print the interval in a diagram. -The @Interval a@ type needs to be an instance of @IntervalSizeable a b@;-Moreover, the type @b@ should be castable to @Int@,-using its @'Witch.From' b Int@ instance.- >>> pretty $ makeIntervalText '-' (beginerval 5 (0::Int)) ----- >>> pretty $ makeIntervalText '*' (beginerval 10 (0::Int))@@ -140,15 +124,6 @@ c = getPairData x i = getInterval x -instance From (Char, Interval a) (IntervalText a) where- from = uncurry makeIntervalText--instance From (IntervalText a) Char where- from (MkIntervalText x) = getPairData x--instance From (IntervalText a) (Interval a) where- from = getInterval- {------------------------------------------------------------------------------- IntervalTextLine -------------------------------------------------------------------------------}@@ -159,22 +134,22 @@ Values of this type should only be created through the 'parseIntervalTextLine' function,-which checks that the inputs are parsed correctly to form intervals +which checks that the inputs are parsed correctly to form intervals that will be pretty-printed correctly. >>> let i1 = makeIntervalText '*' (beginerval 10 (5::Int)) >>> let i2 = makeIntervalText '-' (beginerval 2 (1::Int))->>> let x = parseIntervalTextLine [] [i1, i2] +>>> let x = parseIntervalTextLine [] [i1, i2] >>> pretty x UnsortedIntervals >>> let i1 = makeIntervalText '*' (beginerval 10 (5::Int)) >>> let i2 = makeIntervalText '-' (beginerval 2 (10::Int))->>> let x = parseIntervalTextLine [] [i1, i2] +>>> let x = parseIntervalTextLine [] [i1, i2] >>> pretty x ConcurringIntervals >>> let i1 = makeIntervalText '*' (beginerval 10 ((-1)::Int)) >>> let i2 = makeIntervalText '-' (beginerval 2 (10::Int))->>> let x = parseIntervalTextLine [] [i1, i2] +>>> let x = parseIntervalTextLine [] [i1, i2] >>> pretty x BeginsLessThanZero >>> let i1 = makeIntervalText '*' (beginerval 5 (0::Int))@@ -221,7 +196,7 @@ when a list of @IntervalText@ is parsed into a @IntervalTextLine@. -} data IntervalTextLineParseError =- -- | The inputs contains concurring intervals. + -- | The inputs contains concurring intervals. -- All inputs should be @'disjoint'@. ConcurringIntervals -- | The inputs are not sorted.@@ -257,7 +232,7 @@ {- Modifies the inputs sequentially so that the begin of one interval is- shifted based on the end of the previous interval. + shifted based on the end of the previous interval. This function assumes that the inputs are sorted and disjoint. -} makeIntervalLine@@ -274,7 +249,7 @@ {-------------------------------------------------------------------------------- Axis Config and Components + Axis Config and Components -------------------------------------------------------------------------------} {-|@@ -283,14 +258,17 @@ data AxisPlacement = -- | Print the axis at the top of the diagram Top- -- | Print the axis at the bottom of the diagram + -- | Print the axis at the bottom of the diagram | Bottom deriving (Eq, Show) {-|-Type containing data that can be presented below the axis-on an @IntervalDiagram@.+Key-value list data that can be presented below the axis on an+@IntervalDiagram@. First element of the tuple is an Int key, the second the+Char to print. Note that it does not guarantee uniqueness of the keys, and most+if not all functions should first call @intMapList@ on the internal+@NE.NonEmpty@ list before using this type. -}-newtype AxisLabels = MkAxisLabels (NEM.NEIntMap Char)+newtype AxisLabels = MkAxisLabels (NE.NonEmpty (Int, Char)) deriving (Eq, Show) {-|@@ -303,10 +281,22 @@ } deriving (Eq, Show) +-- Internal utility to give equivalent structure to IntMap from+-- Data.IntMap.NonEmpty for the key-value list in @AxisLabels@. Previously,+-- when using IntMap for the @AxisLabels@ container, uniqueness and ordering of+-- keys was guaranteed. Now, you should first call this function before using+-- those keys, e.g. in @prettyAxisLabels@, to get the same properties. This has+-- a runtime cost and could be rewritten for efficiency if that were a concern.+-- NOTE: NE does not have a sortOn.+intMapList :: NE.NonEmpty (Int, a) -> NE.NonEmpty (Int, a)+intMapList = NE.sortBy (\(k, _) (k', _) -> compare k k')+ . NE.nubBy (\(k, _) (k', _) -> k == k')+ prettyAxisLabels :: AxisPlacement -> AxisLabels -> [Doc ann] prettyAxisLabels pos (MkAxisLabels labs) = do- let ints = NEM.keys labs- let marks = toList $ NEM.elems labs+ let labssorted = intMapList labs+ let ints = NE.map fst labssorted+ let marks = toList $ NE.map snd labssorted let labPos = NE.head ints : zipWith (\x y -> y - x - 1) (toList ints) (NE.tail ints) let out =@@ -318,7 +308,7 @@ Bottom -> out {-------------------------------------------------------------------------------- Axis + Axis -------------------------------------------------------------------------------} {-|@@ -327,14 +317,14 @@ Use 'parseAxis' for construction. >>> let ref = makeIntervalText '=' (beginerval 10 (0::Int))- + >>> let b = parseAxis [] (Just Top) ref->>> pretty b +>>> pretty b ========== >>> let c = parseAxis [(4, 'a'), (6, 'b')] (Just Top) ref->>> pretty c +>>> pretty c a b | | ==========@@ -396,8 +386,8 @@ -- if the axis is not shown then any labels are ignored parseAxis _ Nothing i = Right $ MkAxis i (MkAxisConfig Nothing Nothing) parseAxis l (Just p) i = do- let labels = NEM.fromList <$> NE.nonEmpty l- let labPos = NEM.keys <$> labels+ let labels = intMapList <$> NE.nonEmpty l+ let labPos = NE.map fst <$> labels let inputLabelCount = length l if |@@ -405,7 +395,7 @@ any (\x -> x < begin i || x > end i) (fmap fst l) -> Left LabelsBeyondReference |--- Identify if the number of elements in the input list is different +-- Identify if the number of elements in the input list is different -- from the number of elements after transforming the list -- into a nonempty IntMap. -- If different, then flag.@@ -457,9 +447,9 @@ :: IntervalDiagramOptions -> Either IntervalDiagramOptionsError IntervalDiagramOptions parseDiagramOptions opts = if- | leftPadding opts < 0 -> Left LeftPaddingLessThan0+ | leftPadding opts < 0 -> Left LeftPaddingLessThan0 | layoutPageWidth (layout opts) == Unbounded -> Left UnboundedPageWidth- | otherwise -> Right opts+ | otherwise -> Right opts where isSorted xs = and $ zipWith (<=) xs (tail xs) -- | Default 'IntervalDiagramOptions' options@@ -503,10 +493,10 @@ -- | Indicates that the reference axis is longer than the @'PageWidth'@ -- given in the @'IntervalDiagramOptions'@. | AxisWiderThanAvailable- -- | Indicates that left padding is >0 - -- and no axis is printed. - -- This is considered an error because it be impossible - -- to know the 'begin' values of intervals in a printed @IntervalDiagram@ + -- | Indicates that left padding is >0+ -- and no axis is printed.+ -- This is considered an error because it be impossible+ -- to know the 'begin' values of intervals in a printed @IntervalDiagram@ -- that has been padded and has no axis. | PaddingWithNoAxis -- | Indicates that an error occurring when checking the document options.@@ -529,13 +519,13 @@ -- Position line labels relative to the reference interval -- and the end of the last interval in a line.- -- NOTE: + -- NOTE: -- This is tricky because the intervals -- in a parsed IntervalTextLine are referenced relative -- to the previous interval in the line,- -- not to the reference interval. + -- not to the reference interval. -- See use of makeIntervalLine in parseIntervalTextLine.- -- This why the intervalLineEnd function is used to determine + -- This why the intervalLineEnd function is used to determine -- the end of the intervals in a line. let labelIndents = fmap (diff refDur . intervalLineEnd) ivs @@ -578,14 +568,14 @@ Here's a basic diagram that shows how to put more than one interval interval on a line: ->>> let mkIntrvl c d b = into @(IntervalText Int) (c, bi d (b :: Int))+>>> let mkIntrvl c d b = makeIntervalText c (bi d (b :: Int)) >>> let x = mkIntrvl '=' 20 0 >>> let l1 = [ mkIntrvl '-' 1 4 ] >>> let l2 = [ mkIntrvl '*' 3 5, mkIntrvl '*' 5 10, mkIntrvl 'x' 1 17 ] >>> let l3 = [ mkIntrvl '#' 2 18] >>> pretty $ parseIntervalDiagram defaultIntervalDiagramOptions [] (Just Bottom) x [ (l1, []), (l2, []), (l3, []) ]- - - *** ***** x + -+ *** ***** x ## ==================== @@ -594,16 +584,16 @@ >>> pretty $ parseIntervalDiagram defaultIntervalDiagramOptions [] (Just Top) x [ (l1, []), (l2, []), (l3, []) ] ====================- - - *** ***** x + -+ *** ***** x ## We can annotate the axis: >>> pretty $ parseIntervalDiagram defaultIntervalDiagramOptions [(5, 'a')] (Just Bottom) x [ (l1, []), (l2, []), (l3, []) ]- - - *** ***** x + -+ *** ***** x ## ==================== |@@ -692,7 +682,7 @@ {-| Given a reference interval and a list of intervals, produces an 'IntervalDiagram' with one line per interval,-using the 'defaultIntervalDiagramOptions'. +using the 'defaultIntervalDiagramOptions'. >>> pretty $ simpleIntervalDiagram (bi 10 (0 :: Int)) (fmap (bi 1) [0..9]) -@@ -709,7 +699,7 @@ >>> let ref = bi 30 (0 :: Int) >>> let ivs = [ bi 2 0, bi 5 10, bi 6 16 ]->>> pretty $ simpleIntervalDiagram ref ivs +>>> pretty $ simpleIntervalDiagram ref ivs -- ----- ------
src/IntervalAlgebra/IntervalUtilities.hs view
@@ -8,11 +8,11 @@ -} -{-# LANGUAGE Safe #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} module IntervalAlgebra.IntervalUtilities (@@ -78,109 +78,55 @@ , durations ) where -import safe Control.Applicative ( (<$>)- , (<*>)- , Applicative(pure)- , liftA2- )-import qualified Control.Foldl as L-import safe Control.Monad ( Functor(fmap) )-import safe Data.Bool ( (&&)- , Bool(..)- , not- , otherwise- , (||)- )-import safe Data.Eq ( Eq((==)) )-import safe Data.Foldable ( Foldable- ( foldl'- , foldr- , null- , toList- )- , all- , any- , or- )-import safe Data.Function ( ($)- , (.)- , flip- )-import safe Data.List ( map- , reverse- , sortOn- )-import safe Data.Maybe ( Maybe(..)- , maybe- , maybeToList- )-import safe Data.Monoid ( Monoid(mempty) )-import safe Data.Ord ( (<)- , (>=)- , Ord(max, min)- )-import safe Data.Semigroup ( Semigroup((<>)) )-import safe Data.Traversable ( Traversable(sequenceA) )-import safe Data.Tuple ( fst- , uncurry- )-import safe GHC.Int ( Int )-import safe GHC.Show ( Show )-import safe IntervalAlgebra.Core ( (<|>)- , ComparativePredicateOf1- , ComparativePredicateOf2- , Interval- , IntervalCombinable((><))- , IntervalRelation(..)- , IntervalSizeable- ( diff- , duration- )- , Intervallic(..)- , after- , before- , begin- , beginerval- , beginervalFromEnd- , bi- , concur- , contains- , disjoint- , during- , enclosedBy- , encloses- , end- , enderval- , endervalFromBegin- , equals- , extenterval- , finishedBy- , finishes- , meets- , metBy- , notDisjoint- , overlappedBy- , overlaps- , relate- , startedBy- , starts- , within- )-import safe IntervalAlgebra.PairedInterval ( PairedInterval- , equalPairData- , getPairData- , makePairedInterval- )-import safe Safe ( headMay- , initSafe- , lastMay- , tailSafe- )-import safe Witherable ( Filterable(filter)- , Witherable(..)- , catMaybes- , mapMaybe- )+import safe Control.Applicative (Applicative (pure),+ liftA2, (<$>), (<*>))+import qualified Control.Foldl as L+import safe Control.Monad (Functor (fmap))+import safe Data.Bool (Bool (..), not, otherwise,+ (&&), (||))+import safe Data.Eq (Eq ((==)))+import safe Data.Foldable (Foldable (foldl', foldr, null, toList),+ all, any, or)+import safe Data.Function (flip, ($), (.))+import safe Data.List (map, reverse, sortOn)+import safe Data.Maybe (Maybe (..), maybe,+ maybeToList)+import safe Data.Monoid (Monoid (mempty))+import safe Data.Ord (Ord (max, min), (<), (>=))+import safe Data.Semigroup (Semigroup ((<>)))+import safe Data.Traversable (Traversable (sequenceA))+import safe Data.Tuple (fst, uncurry)+import safe GHC.Int (Int)+import safe GHC.Show (Show)+import safe IntervalAlgebra.Core (ComparativePredicateOf1,+ ComparativePredicateOf2,+ Interval,+ IntervalCombinable ((><)),+ IntervalRelation (..),+ IntervalSizeable (diff, duration),+ Intervallic (..), after,+ before, begin, beginerval,+ beginervalFromEnd, bi,+ concur, contains,+ disjoint, during,+ enclosedBy, encloses, end,+ enderval,+ endervalFromBegin, equals,+ extenterval, finishedBy,+ finishes, meets, metBy,+ notDisjoint, overlappedBy,+ overlaps, relate,+ startedBy, starts, within,+ (<|>))+import safe IntervalAlgebra.PairedInterval (PairedInterval,+ equalPairData,+ getPairData,+ makePairedInterval)+import safe Safe (headMay, initSafe,+ lastMay, tailSafe)+import safe Witherable (Filterable (filter),+ Witherable (..),+ catMaybes, mapMaybe) {- $setup >>> import GHC.List ( (++), zip )@@ -237,7 +183,7 @@ go [] = [] go (x : xs) = fmap (x, ) xs <> go xs --- | Creates a new @Interval@ of a provided lookback duration ending at the +-- | Creates a new @Interval@ of a provided lookback duration ending at the -- 'begin' of the input interval. -- -- >>> lookback 4 (beginerval 10 (1 :: Int))@@ -249,7 +195,7 @@ -> Interval a lookback d x = enderval d (begin x) --- | Creates a new @Interval@ of a provided lookahead duration beginning at the +-- | Creates a new @Interval@ of a provided lookahead duration beginning at the -- 'end' of the input interval. -- -- >>> lookahead 4 (beginerval 1 (1 :: Int))@@ -299,8 +245,8 @@ allGapsWithinLessThanDuration = makeGapsWithinPredicate all (<) --- Used to combine two lists by combining the last element of @x@ and the first --- element of @y@ by @f@. The combining function @f@ will generally return a +-- Used to combine two lists by combining the last element of @x@ and the first+-- element of @y@ by @f@. The combining function @f@ will generally return a -- singleton list in the case that the last of x and head of y can be combined -- or a two element list in the case they cannot. listCombiner@@ -311,7 +257,7 @@ listCombiner f x y = initSafe x <> f (lastMay x) (headMay y) <> tailSafe y {-# INLINABLE listCombiner #-} --- | Returns a list of the 'IntervalRelation' between each consecutive pair +-- | Returns a list of the 'IntervalRelation' between each consecutive pair -- of intervals. This is just a specialized 'relations' which returns a list. -- -- >>> relationsL [bi 1 0, bi 1 1]@@ -321,7 +267,7 @@ :: (Foldable f, Ord a, Intervallic i) => f (i a) -> [IntervalRelation] relationsL = relations --- | A generic form of 'relations' which can output any 'Applicative' and +-- | A generic form of 'relations' which can output any 'Applicative' and -- 'Monoid' structure. -- -- >>> (relations [bi 1 0,bi 1 1]) :: [IntervalRelation]@@ -340,9 +286,9 @@ relations = L.fold (makeFolder relate) {-# INLINABLE relations #-} --- | Forms a 'Just' new interval from the intersection of two intervals, +-- | Forms a 'Just' new interval from the intersection of two intervals, -- provided the intervals are not disjoint.--- +-- -- >>> intersect (bi 5 0) (bi 2 3) -- Just (3, 5) --@@ -478,7 +424,7 @@ durations = fmap duration -- | In the case that x y are not disjoint, clips y to the extent of x.--- +-- -- >>> clip (bi 5 0) ((bi 3 3) :: Interval Int) -- Just (3, 5) --@@ -502,10 +448,10 @@ {-# INLINABLE clip #-} -- | 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 +-- 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. -- -- >>> gapsWithin (bi 9 1) [bi 5 0, bi 2 7, bi 3 12]@@ -679,7 +625,7 @@ rangeInterval :: (Ord a, L.Foldable t) => t (Interval a) -> Maybe (Interval a) rangeInterval = L.fold (liftA2 extenterval <$> L.minimum <*> L.maximum) --- | Given a predicate combinator, a predicate, and list of intervals, returns +-- | Given a predicate combinator, a predicate, and list of intervals, returns -- the input unchanged if the predicate combinator is @True@. Otherwise, returns -- an empty list. See 'nothingIfAny' and 'nothingIfNone' for examples. nothingIf@@ -693,7 +639,7 @@ -- | Returns the 'Nothing' if *none* of the element of input satisfy -- the predicate condition.--- +-- -- For example, the following returns 'Nothing' because none of the intervals -- in the input list 'starts' (3, 5). --@@ -739,8 +685,8 @@ -> Maybe (f (i a)) nothingIfAll = nothingIf all --- | Creates a function for filtering a 'Witherable.Filterable' of @i1 a@s --- by comparing the @Interval a@s that of an @i0 a@. +-- | 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, Intervallic i1) => ComparativePredicateOf2 (i0 a) (i1 a)@@ -748,8 +694,8 @@ -> (f (i1 a) -> f (i1 a)) makeFilter f p = Witherable.filter (f p) -{- | -Filter 'Witherable.Filterable' containers of one @'Intervallic'@ type based by comparing to +{- |+Filter 'Witherable.Filterable' containers of one @'Intervallic'@ type based by comparing to a (potentially different) 'Intervallic' type using the corresponding interval predicate function. -}@@ -778,21 +724,21 @@ filterEncloses = makeFilter encloses filterEnclosedBy = makeFilter enclosedBy --- | Folds over a list of Paired Intervals and in the case that the 'getPairData' --- is equal between two sequential meeting intervals, these two intervals are +-- | Folds over a list of Paired Intervals and in the case that the 'getPairData'+-- is equal between two sequential meeting intervals, these two intervals are -- combined into one. This function is "safe" in the sense that if the input is -- invalid and contains any sequential pairs of intervals with an @IntervalRelation@,--- other than 'Meets', then the function returns an empty list. +-- other than 'Meets', then the function returns an empty list. foldMeetingSafe :: (Eq b, Ord a, Show a)- => [PairedInterval b a] -- ^ Be sure this only contains intervals + => [PairedInterval b a] -- ^ Be sure this only contains intervals -- that sequentially 'meets'. -> [PairedInterval b a] foldMeetingSafe l = maybe [] (getMeeting . foldMeeting) (parseMeeting l) --- | Folds over a list of Meeting Paired Intervals and in the case that the 'getPairData' --- is equal between two sequential meeting intervals, these two intervals are --- combined into one. +-- | Folds over a list of Meeting Paired Intervals and in the case that the 'getPairData'+-- is equal between two sequential meeting intervals, these two intervals are+-- combined into one. foldMeeting :: (Eq b, Ord a, Show a) => Meeting [PairedInterval b a]@@ -800,7 +746,7 @@ foldMeeting (Meeting l) = foldl' joinMeetingPairedInterval (Meeting []) (packMeeting l) --- This type identifies that @a@ contains intervals that sequentially meet one +-- This type identifies that @a@ contains intervals that sequentially meet one -- another. newtype Meeting a = Meeting { getMeeting :: a } deriving (Eq, Show) @@ -845,12 +791,12 @@ join2MeetingWhen p (Just x) (Just y) | p x y = [setInterval y (extenterval x y)] | otherwise = pure x <> pure y -{- | +{- | Takes two *ordered* events, x <= y, and "disjoins" them in the case that the-two events have different states, creating a sequence (list) of new events that +two events have different states, creating a sequence (list) of new events that sequentially meet one another. Since x <= y, there are 7 possible interval-relations between x and y. If the states of x and y are equal and x is not -before y, then x and y are combined into a single event. +relations between x and y. If the states of x and y are equal and x is not+before y, then x and y are combined into a single event. -} disjoinPaired :: (Eq b, Monoid b, Show a, IntervalSizeable a c)@@ -881,13 +827,13 @@ evp b e = ev (beginerval (diff e b) b) {-# INLINABLE disjoinPaired #-} -{- | +{- | The internal function for converting a non-disjoint, ordered sequence of events into a disjoint, ordered sequence of events. The function operates-by recursion on a pair of events and the input events. The first of the -is the accumulator set -- the disjoint events that need no longer be +by recursion on a pair of events and the input events. The first of the+is the accumulator set -- the disjoint events that need no longer be compared to input events. The second of the pair are disjoint events that-still need to be compared to be input events. +still need to be compared to be input events. -} recurseDisjoin :: (Monoid b, Eq b, IntervalSizeable a c, Show a)@@ -895,19 +841,19 @@ -> [(PairedInterval b) a] -> [(PairedInterval b) a] recurseDisjoin (acc, o : os) [] = acc <> (o : os) -- the "final" pattern-recurseDisjoin (acc, [] ) [] = acc -- another "final" pattern +recurseDisjoin (acc, [] ) [] = acc -- another "final" pattern recurseDisjoin (acc, [] ) (e : es) = recurseDisjoin (acc, [e]) es -- the "initialize" pattern recurseDisjoin (acc, o : os) (e : es)- | -- the "operating" patterns + | -- the "operating" patterns -- If input event is equal to the first comparator, skip the comparison. e == o = recurseDisjoin (acc, o : os) es | - {- If o is either before or meets e, then - the first of the combined events can be put into the accumulator. - That is, since the inputs events are ordered, once the beginning of o - is before or meets e, then we are assured that all periods up to the - beginning of o are fully disjoint and subsequent input events will + {- If o is either before or meets e, then+ the first of the combined events can be put into the accumulator.+ That is, since the inputs events are ordered, once the beginning of o+ is before or meets e, then we are assured that all periods up to the+ beginning of o are fully disjoint and subsequent input events will not overlap these in any way. -} (before <|> meets) o e = recurseDisjoin (acc <> nh, recurseDisjoin ([], nt) os)@@ -922,12 +868,12 @@ nt = tailSafe n {-# INLINABLE recurseDisjoin #-} -{- | +{- | Convert an ordered sequence of @PairedInterval b a@. that may have any interval relation-('before', 'starts', etc) into a sequence of sequentially meeting @PairedInterval b a@. -That is, a sequence where one the end of one interval meets the beginning of +('before', 'starts', etc) into a sequence of sequentially meeting @PairedInterval b a@.+That is, a sequence where one the end of one interval meets the beginning of the subsequent event. The 'getPairData' of the input @PairedIntervals@ are-combined using the Monoid '<>' function, hence the pair data must be a +combined using the Monoid '<>' function, hence the pair data must be a 'Monoid' instance. -} formMeetingSequence@@ -940,7 +886,7 @@ | otherwise = formMeetingSequence (recurseDisjoin ([], []) x) -- recurseDisjoin ([], []) (recurseDisjoin ([], []) (recurseDisjoin ([], []) x)) - -- the multiple passes of recurseDisjoin is to handle the situation where the + -- the multiple passes of recurseDisjoin is to handle the situation where the -- initial passes almost disjoins all the events correctly into a meeting sequence -- but due to nesting of intervals in the input -- some of the sequential pairs have -- the same data after the first pass. The recursive passes merges any sequential
src/IntervalAlgebra/PairedInterval.hs view
@@ -1,5 +1,5 @@ {-|-Module : Paired interval +Module : Paired interval Description : Extends the Interval Algebra to an interval paired with some data. Copyright : (c) NoviSci, Inc 2020 License : BSD3@@ -7,10 +7,10 @@ Stability : experimental -} {-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Safe #-} module IntervalAlgebra.PairedInterval ( PairedInterval@@ -23,20 +23,16 @@ , trivialize ) where -import safe Control.Applicative ( liftA2 )-import safe Control.DeepSeq ( NFData )-import safe Data.Binary ( Binary )-import safe GHC.Generics ( Generic )-import safe IntervalAlgebra.Core ( ComparativePredicateOf1- , Interval- , IntervalCombinable(..)- , IntervalSizeable- , Intervallic(..)- , before- , extenterval- )-import safe Test.QuickCheck ( Arbitrary(..) )-import safe Witherable ( Filterable(filter) )+import safe Control.Applicative (liftA2)+import safe Control.DeepSeq (NFData)+import safe Data.Binary (Binary)+import safe GHC.Generics (Generic)+import safe IntervalAlgebra.Core (ComparativePredicateOf1, Interval,+ IntervalCombinable (..),+ IntervalSizeable, Intervallic (..),+ before, extenterval)+import safe Test.QuickCheck (Arbitrary (..))+import safe Witherable (Filterable (filter)) -- | An @Interval a@ paired with some other data of type @b@. newtype PairedInterval b a = PairedInterval (Interval a, b)@@ -67,7 +63,7 @@ | otherwise = pure $ makePairedInterval (getPairData x <> getPairData y) (extenterval x y) --- | Make a paired interval. +-- | Make a paired interval. makePairedInterval :: b -> Interval a -> PairedInterval b a makePairedInterval d i = PairedInterval (i, d) @@ -90,7 +86,6 @@ x <> y = Empty instance Monoid Empty where mempty = Empty- mappend x y = x <> y -- | Lifts an @Interval a@ into a @PairedInterval Empty a@, where @Empty@ is a -- trivial type that contains no data.
src/IntervalAlgebra/RelationProperties.hs view
@@ -5,7 +5,7 @@ License : BSD3 Maintainer : bsaul@novisci.com -This module exports a single typeclass @IntervalAxioms@ which contains +This module exports a single typeclass @IntervalAxioms@ which contains property-based tests for the axioms in section 1 of [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x). The notation below is that of the original paper. @@ -13,34 +13,21 @@ -} {- HLINT ignore -}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} module IntervalAlgebra.RelationProperties ( IntervalRelationProperties(..) ) where -import Data.Maybe ( fromJust- , isJust- , isNothing- )-import Data.Set ( Set- , disjointUnion- , fromList- , member- )-import Data.Time as DT- ( Day- , NominalDiffTime- , UTCTime- )+import Data.Maybe (fromJust, isJust, isNothing)+import Data.Set (Set, disjointUnion, fromList,+ member)+import Data.Time as DT (Day, NominalDiffTime, UTCTime) import IntervalAlgebra.Arbitrary import IntervalAlgebra.Core-import Test.QuickCheck ( (===)- , (==>)- , Arbitrary(arbitrary)- , Property- )+import Test.QuickCheck (Arbitrary (arbitrary), Property,+ (===), (==>)) allIArelations :: (Ord a) => [ComparativePredicateOf1 (Interval a)] allIArelations =@@ -59,7 +46,7 @@ , contains ] --- | A collection of properties for the interval algebra. Some of these come from +-- | A collection of properties for the interval algebra. Some of these come from -- figure 2 in [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x). class ( IntervalSizeable a b ) => IntervalRelationProperties a b where @@ -68,8 +55,8 @@ prop_exclusiveRelations x y = ( 1 == length (filter id $ map (\r -> r x y) allIArelations)) === True - -- | Given a set of interval relations and predicate function, test that the - -- predicate between two interval is equivalent to the relation of two intervals + -- | Given a set of interval relations and predicate function, test that the+ -- predicate between two interval is equivalent to the relation of two intervals -- being in the set of relations. prop_predicate_unions :: Ord a => Set IntervalRelation
test-axioms/AxiomsSpec.hs view
@@ -1,28 +1,18 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-} module AxiomsSpec ( spec ) where -import Data.Time ( Day- , UTCTime- )-import IntervalAlgebra.Axioms ( IntervalAxioms(..) )-import Test.Hspec ( Spec- , describe- , hspec- , it- )-import Test.Hspec.QuickCheck ( modifyMaxSuccess )-import Test.QuickCheck ( Arbitrary(arbitrary)- , Gen(..)- , Property- , Testable(property)- , generate- , quickCheck- )+import Data.Time (Day, UTCTime)+import IntervalAlgebra.Axioms (IntervalAxioms (..))+import Test.Hspec (Spec, describe, hspec, it)+import Test.Hspec.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck (Arbitrary (arbitrary), Gen (..),+ Property, Testable (property),+ generate, quickCheck) testScale :: Int
test-relation-properties/RelationPropertiesSpec.hs view
@@ -1,21 +1,15 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-} module RelationPropertiesSpec ( spec ) where import Data.Time-import IntervalAlgebra.RelationProperties- ( IntervalRelationProperties(..)- )-import Test.Hspec ( Spec- , describe- , hspec- , it- )-import Test.Hspec.QuickCheck ( modifyMaxSuccess )+import IntervalAlgebra.RelationProperties (IntervalRelationProperties (..))+import Test.Hspec (Spec, describe, hspec, it)+import Test.Hspec.QuickCheck (modifyMaxSuccess) import Test.QuickCheck testScale = 100
test/IntervalAlgebra/IntervalUtilitiesSpec.hs view
@@ -6,104 +6,67 @@ ( spec ) where -import Control.Monad ( liftM2 )-import Data.List ( sort )-import Data.Maybe ( fromJust- , isJust- , isNothing- )-import Data.Set ( Set- , difference- , fromList- , member- , toList- )-import qualified Data.Set ( null )-import Data.Time ( Day- , UTCTime- )-import IntervalAlgebra ( Interval- , IntervalCombinable(..)- , IntervalRelation(..)- , IntervalSizeable- , Intervallic(..)- , beginerval- , complement- , converse- , disjointRelations- , duration- , intervalRelations- , moment- , predicate- , rangeInterval- , safeInterval- , starts- , strictWithinRelations- , withinRelations- )-import IntervalAlgebra.Arbitrary ( arbitraryWithRelation )-import IntervalAlgebra.IntervalUtilities- ( clip- , combineIntervals- , combineIntervalsFromSorted- , durations- , filterAfter- , filterBefore- , filterConcur- , filterContains- , filterDisjoint- , filterDuring- , filterEnclosedBy- , filterEncloses- , filterEquals- , filterFinishedBy- , filterFinishes- , filterMeets- , filterMetBy- , filterNotDisjoint- , filterOverlappedBy- , filterOverlaps- , filterStartedBy- , filterStarts- , filterWithin- , foldMeetingSafe- , formMeetingSequence- , gaps- , gapsL- , gapsWithin- , intersect- , nothingIfAll- , nothingIfAny- , nothingIfNone- , relationsL- )-import IntervalAlgebra.PairedInterval ( PairedInterval- , getPairData- , makePairedInterval- , trivialize- )-import Test.Hspec ( Spec- , describe- , it- , shouldBe- )-import Test.Hspec.QuickCheck ( modifyMaxDiscardRatio- , modifyMaxSuccess- )-import Test.QuickCheck ( (===)- , (==>)- , Arbitrary(arbitrary, shrink)- , Arbitrary1(liftArbitrary)- , Property- , Testable(property)- , elements- , listOf- , orderedList- , resize- , sublistOf- , suchThat- )-import Witherable ( Filterable )+import Control.Monad (liftM2)+import Data.List (sort)+import Data.Maybe (fromJust, isJust, isNothing)+import Data.Set (Set, difference, fromList,+ member, toList)+import qualified Data.Set (null)+import Data.Time (Day, UTCTime)+import IntervalAlgebra (Interval,+ IntervalCombinable (..),+ IntervalRelation (..),+ IntervalSizeable,+ Intervallic (..),+ beginerval, complement,+ converse, disjointRelations,+ duration, intervalRelations,+ moment, predicate,+ rangeInterval, safeInterval,+ starts,+ strictWithinRelations,+ withinRelations)+import IntervalAlgebra.Arbitrary (arbitraryWithRelation)+import IntervalAlgebra.IntervalUtilities (clip, combineIntervals,+ combineIntervalsFromSorted,+ durations, filterAfter,+ filterBefore, filterConcur,+ filterContains,+ filterDisjoint,+ filterDuring,+ filterEnclosedBy,+ filterEncloses,+ filterEquals,+ filterFinishedBy,+ filterFinishes, filterMeets,+ filterMetBy,+ filterNotDisjoint,+ filterOverlappedBy,+ filterOverlaps,+ filterStartedBy,+ filterStarts, filterWithin,+ foldMeetingSafe,+ formMeetingSequence, gaps,+ gapsL, gapsWithin,+ intersect, nothingIfAll,+ nothingIfAny, nothingIfNone,+ relationsL)+import IntervalAlgebra.PairedInterval (PairedInterval, getPairData,+ makePairedInterval,+ trivialize)+import Test.Hspec (Spec, describe, it,+ shouldBe)+import Test.Hspec.QuickCheck (modifyMaxDiscardRatio,+ modifyMaxSuccess)+import Test.QuickCheck (Arbitrary (arbitrary, shrink),+ Arbitrary1 (liftArbitrary),+ Property,+ Testable (property),+ elements, listOf,+ orderedList, resize,+ sublistOf, suchThat, (===),+ (==>))+import Witherable (Filterable) -- Types for testing
test/IntervalAlgebra/PairedIntervalSpec.hs view
@@ -3,26 +3,15 @@ ) where import Data.Bool-import Data.Time ( Day(ModifiedJulianDay)- , fromGregorian- )-import IntervalAlgebra ( IntervalCombinable(..)- , IntervalSizeable(duration)- , before- , beginerval- , equals- , toEnumInterval- )-import IntervalAlgebra.PairedInterval ( Empty(..)- , PairedInterval- , intervals- , makePairedInterval- )-import Test.Hspec ( Spec- , describe- , it- , shouldBe- )+import Data.Time (Day (ModifiedJulianDay),+ fromGregorian)+import IntervalAlgebra (IntervalCombinable (..),+ IntervalSizeable (duration),+ before, beginerval, equals,+ toEnumInterval)+import IntervalAlgebra.PairedInterval (Empty (..), PairedInterval,+ intervals, makePairedInterval)+import Test.Hspec (Spec, describe, it, shouldBe) type TestPair = PairedInterval String Int @@ -72,6 +61,6 @@ it "show empty" $ show Empty `shouldBe` "Empty" it "combine emptyies" $ Empty <> Empty `shouldBe` Empty it "monoid empty" $ (mempty :: Empty) `shouldBe` Empty- it "monoid mappend" $ mappend Empty Empty `shouldBe` Empty+ it "monoid <>" $ Empty <> Empty `shouldBe` Empty it "ord empty" $ Empty < Empty `shouldBe` False it "ord empty" $ Empty <= Empty `shouldBe` True
test/IntervalAlgebraSpec.hs view
@@ -1,54 +1,30 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-} module IntervalAlgebraSpec ( spec ) where -import Data.Either ( isRight )-import Data.Fixed ( Pico )-import Data.Maybe ( fromJust- , isJust- , isNothing- )-import Data.Set ( Set- , disjointUnion- , fromList- , member- )-import Data.Time as DT- ( Day(..)- , DiffTime- , NominalDiffTime- , UTCTime(..)- , fromGregorian- , picosecondsToDiffTime- , secondsToDiffTime- )-import GHC.Real ( Rational(..)- , Real(..)- )-import IntervalAlgebra as IA-import IntervalAlgebra.Arbitrary ( )-import Test.Hspec ( Spec- , describe- , hspec- , it- , shouldBe- )-import Test.Hspec.QuickCheck ( modifyMaxDiscardRatio- , modifyMaxSuccess- )-import Test.QuickCheck ( (===)- , (==>)- , Arbitrary(arbitrary)- , Gen(..)- , Property- , Testable(property)- , generate- , quickCheck- )+import Data.Either (isRight)+import Data.Fixed (Pico)+import Data.Maybe (fromJust, isJust, isNothing)+import Data.Set (Set, disjointUnion, fromList,+ member)+import Data.Time as DT (Day (..), DiffTime,+ NominalDiffTime, UTCTime (..),+ fromGregorian,+ picosecondsToDiffTime,+ secondsToDiffTime)+import GHC.Real (Rational (..), Real (..))+import IntervalAlgebra as IA+import IntervalAlgebra.Arbitrary ()+import Test.Hspec (Spec, describe, hspec, it, shouldBe)+import Test.Hspec.QuickCheck (modifyMaxDiscardRatio,+ modifyMaxSuccess)+import Test.QuickCheck (Arbitrary (arbitrary), Gen (..),+ Property, Testable (property),+ generate, quickCheck, (===), (==>)) mkIntrvl :: Int -> Int -> Interval Int mkIntrvl = beginerval
tutorial/TutorialMain.hs view
@@ -6,15 +6,22 @@ module Main where -- tag::import-declarations[]-import IntervalAlgebra-import IntervalAlgebra.IntervalDiagram+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 )+import Data.Bifunctor ( Bifunctor(..) )+import Data.List ( sort )+import Data.Set ( Set+ , difference+ , fromList+ )+import Data.Time ( Day+ , UTCTime(..)+ , addDays+ , fromGregorian+ , secondsToDiffTime+ )+import Witch ( into ) -- end::import-declarations[] main :: IO ()@@ -22,7 +29,8 @@ -- Add file header ----------------------------------------------------------- - putStrLn "Generated by running `cabal run tutorial -v0 > tutorial/TutorialMain.out`"+ putStrLn+ "Generated by running `cabal run tutorial -v0 > tutorial/TutorialMain.out`" putStrLn "Do not edit by hand\n\n" @@ -173,10 +181,13 @@ 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 $ setInterval pairListstringInteger (safeInterval (4, 9) :: Interval Integer)\n---> "+ print $ setInterval pairListstringInteger+ (safeInterval (4, 9) :: Interval Integer) - putStr "\nprint $ intervals [pairListstringInteger, pairListstringInteger]\n---> "+ putStr+ "\nprint $ intervals [pairListstringInteger, pairListstringInteger]\n---> " print $ intervals [pairListstringInteger, pairListstringInteger] putStr "\nprint $ begin pairListstringInteger\n---> "@@ -198,7 +209,8 @@ putStr "\nprint $ getPairData pairStringDay\n---> " print $ getPairData pairStringDay - putStr "\nprint $ makePairedInterval \"ski trip\" (getInterval pairStringDay)\n---> "+ putStr+ "\nprint $ makePairedInterval \"ski trip\" (getInterval pairStringDay)\n---> " print $ makePairedInterval "ski trip" (getInterval pairStringDay) putStrLn "-- end::pairedinterval-getset-data-print[]"@@ -214,7 +226,8 @@ putStr "\nprint $ getInterval ivInteger\n---> " print $ getInterval ivInteger - putStr "\nprint $ setInterval ivInteger (beginerval 3 12 :: Interval Integer)\n---> "+ putStr+ "\nprint $ setInterval ivInteger (beginerval 3 12 :: Interval Integer)\n---> " print $ setInterval ivInteger (beginerval 3 12 :: Interval Integer) putStr "\nprint $ begin ivInteger\n---> "@@ -252,7 +265,8 @@ putStrLn "-- tag::intervalcombinable-interval-print[]" - putStrLn "\n-- The Just Interval formed from combining the Intervals, since iv0to2 `meets` iv2to5"+ putStrLn+ "\n-- The Just Interval formed from combining the Intervals, since iv0to2 `meets` iv2to5" putStr "print $ iv0to2 .+. iv2to5\n---> " print $ iv0to2 .+. iv2to5 @@ -260,7 +274,8 @@ 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"+ 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 @@ -275,20 +290,26 @@ 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---> "+ 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---> "+ 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---> "+ 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---> "+ putStr+ "print $ makePairedInterval \"a\" iv0to2 >< makePairedInterval \"b\" iv2to5\n---> " print $ makePairedInterval "a" iv0to2 >< makePairedInterval "b" iv2to5 putStrLn "-- end::intervalcombinable-pairedinterval-print[]"@@ -627,7 +648,8 @@ 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))+id1Event6 =+ makePairedInterval (Diagnosis RightAsRain) (safeInterval (131, 132)) id1Event7 = makePairedInterval (Diagnosis CommonCold) (safeInterval (161, 162)) id1Events :: SubjEvents@@ -653,8 +675,15 @@ id2Events :: SubjEvents id2Events = sort- [ id2Event1, id2Event2, id2Event3, id2Event4, id2Event5 , id2Event6- , id2Event7, id2Event8 ]+ [ id2Event1+ , id2Event2+ , id2Event3+ , id2Event4+ , id2Event5+ , id2Event6+ , id2Event7+ , id2Event8+ ] -- end::extended-example-1-study-data-subj-2[] @@ -663,7 +692,8 @@ id3Event1, id3Event2, id3Event3 :: StudyEvent id3Event1 = makePairedInterval Enrollment (safeInterval (7, 197))-id3Event2 = makePairedInterval (Treatment StandardVaccine) (safeInterval (19, 20))+id3Event2 =+ makePairedInterval (Treatment StandardVaccine) (safeInterval (19, 20)) id3Event3 = makePairedInterval (Diagnosis Flu) (safeInterval (180, 181)) id3Events :: SubjEvents@@ -774,7 +804,7 @@ -> Maybe (i1 a) -> Maybe b calcDiff (Just y) (Just x) = Just $ diff (begin y) (end x)-calcDiff _ _ = Nothing+calcDiff _ _ = Nothing -- Calculate the difference between the end endpoint of the first Intervallic -- and the start endpoint of the second Intervallic@@ -784,7 +814,7 @@ -> Maybe (i1 a) -> Maybe b calcAtRisk (Just y) (Just x) = Just $ diff (end y) (end x)-calcAtRisk _ _ = Nothing+calcAtRisk _ _ = Nothing -- end::extended-example-1-processing-functions[] @@ -802,22 +832,8 @@ -------------------------------------------------------------------------------- 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+diagr = standardExampleDiagram (zip ivs labels) []+ where+ ivs = [iv0to2, iv2to4, iv2to5, iv3to6, iv4to5, iv6to8, iv5to8]+ labels =+ ["iv0to2", "iv2to4", "iv2to5", "iv3to6", "iv4to5", "iv6to8", "iv5to8"]