diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for interval-algebra +## 0.3.0 + +* Adds `beginerval` and `enderval` function to `IntervalSizeable` class for safely creating `Interval`s given a begin (or end) and a duration. +* Moves `moment` to its own typeclass `Moment`, which is now a constraint on `IntervalSizeable`. +* Removes function exports from the `IntervalAlgebra.Arbitrary` module which where only meant to exported for the testing modules anyway. + ## 0.2.0 * Adds `IntervalSizeable` class. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ 1. `Intervallic` provides an interface to the data structure of an `Interval`, defining how an `Interval a` (simply a pair `(a, a)`) is constructed. 2. `IntervalAlgebraic` provides an interface to the `IntervalRelation`s, the workhorse of Allen's temporal logic. 3. `IntervalCombinable` provides an interface to methods of combining multiple `Interval`s. -4. `IntervalSizeable` provides methods for measuring and modifying the size of an interval. +4. `IntervalSizeable` and the related `Moment` provide methods for measuring and modifying the size of an interval. 5. `IntervalFilterable` provides methods for filtering 'Filterable' collections of intervals. An advantage of nested typeclass design is that developers can define an `Interval` of type `a` with just the amount of structure that they need. diff --git a/interval-algebra.cabal b/interval-algebra.cabal --- a/interval-algebra.cabal +++ b/interval-algebra.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: interval-algebra -version: 0.2.0 +version: 0.3.0 synopsis: An implementation of Allen's interval algebra for temporal logic description: Please see the README on GitHub at category: Algebra,Time diff --git a/src/IntervalAlgebra.hs b/src/IntervalAlgebra.hs --- a/src/IntervalAlgebra.hs +++ b/src/IntervalAlgebra.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE ScopedTypeVariables, TypeApplications #-} {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Interval Algebra Description : Implementation of Allen's interval algebra @@ -25,10 +27,10 @@ the workhorse of Allen's temporal logic. 3. @'IntervalCombinable'@ provides an interface to methods of combining two @'Interval's@. -4. @'IntervalSizeable'@ provides methods for measuring and modifying the size - of an interval. -5. @'IntervalFilterable'@ provides methods for filtering 'Witherable.Filterable' collections - of intervals. +4. @'IntervalSizeable'@ and the related @'Moment'@ provides methods for + measuring and modifying the size of an interval. +5. @'IntervalFilterable'@ provides methods for filtering 'Witherable.Filterable' + collections of intervals. An advantage of nested typeclass design is that developers can define an @'Interval'@ of type @a@ with just the amount of structure that they need. @@ -45,12 +47,14 @@ -} +{-# LANGUAGE AllowAmbiguousTypes #-} module IntervalAlgebra( -- * Classes Intervallic(..) , IntervalAlgebraic(..) , IntervalCombinable(..) + , Moment(..) , IntervalSizeable(..) , IntervalFilterable(..) @@ -283,32 +287,31 @@ {- | +The 'Moment' class fixes the smallest duration of an 'Intervallic a'. +-} +class (Intervallic a, Num b, Ord b) => Moment a b| a -> b where + moment :: b + moment = 1 + +{- | The 'IntervalSizeable' typeclass provides functions to determine the size of and to resize an 'Interval a'. -} -class (Intervallic a, Num b, Ord b) => IntervalSizeable a b| a -> b where +class (Intervallic a, Moment a b, Num b, Ord b) => IntervalSizeable a b| a -> b where -- | Determine the duration of an 'Interval a'. duration :: Interval a -> b - -- | Sets the length of a moment for an 'Interval a'. - moment :: a -> b - moment x = 1 - -- TODO: The reason is function takes an argument of type @a@ is due to - -- ambiguous types warnings. I couldn't figure out how to avoid the - -- warnings without turning on AllowAmbiguousTypes Pragma. Is there a - -- better way to handle this? - - -- | Shifts an @a@. Most often, the @c@ will be the same - -- type as the @a@. But for example, if @a@ is 'Day' then @c@ would be 'Int'. + -- | 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 -- | Resize an 'Interval a' to by expanding to "left" by @max l moment@ -- and to the "right" by @min r moment@. expand :: b -> b -> Interval a -> Interval a expand l r p = Interval (s, e) - where s = add (negate $ max l (moment (begin p))) (begin p) - e = add (min r (moment (end p))) (end p) + where s = add (negate $ max l (moment @a)) (begin p) + e = add (min r (moment @a)) (end p) -- | Expands an 'Interval a' to left by i. expandl :: b -> Interval a -> Interval a @@ -318,6 +321,16 @@ expandr :: b -> Interval a -> Interval 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 :: b -> a -> Interval a + beginerval dur x = Interval (x, add (max (moment @a) dur) x) + + -- | Safely creates an 'Interval a' using @x@ as the 'end' and adding + -- @negate max moment dur@ to @x@ as the 'begin'. + enderval :: b -> a -> Interval a + enderval dur x = Interval (add (negate $ max (moment @a) dur) x, x) + {- | The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining two @'Interval's@. @@ -430,6 +443,7 @@ instance Intervallic Int instance IntervalAlgebraic Int instance IntervalCombinable Int +instance Moment Int Int instance IntervalSizeable Int Int where add = (+) duration x = end x - begin x @@ -438,6 +452,7 @@ instance Intervallic Integer instance IntervalAlgebraic Integer instance IntervalCombinable Integer +instance Moment Integer Integer instance IntervalSizeable Integer Integer where add = (+) duration x = end x - begin x @@ -446,6 +461,7 @@ instance Intervallic DT.Day instance IntervalAlgebraic DT.Day instance IntervalCombinable DT.Day +instance Moment DT.Day Integer instance IntervalSizeable DT.Day Integer where add = addDays duration x = diffDays (end x) (begin x) diff --git a/src/IntervalAlgebra/Arbitrary.hs b/src/IntervalAlgebra/Arbitrary.hs --- a/src/IntervalAlgebra/Arbitrary.hs +++ b/src/IntervalAlgebra/Arbitrary.hs @@ -8,61 +8,21 @@ Maintainer : bsaul@novisci.com Stability : experimental -} -module IntervalAlgebra.Arbitrary( - makePos - , safeInterval - , safeInterval' - , safeInterval'' -) where +module IntervalAlgebra.Arbitrary() where import Test.QuickCheck ( Arbitrary(arbitrary, shrink) ) -import GHC.Base - ( otherwise, - ($), - Eq((==)), - Ord((<=), (<), min, max), - Int, - Maybe(..), - (.), - liftM2 ) +import GHC.Base(Int, (.), liftM2 ) import Control.Applicative((<$>)) import GHC.Num ( Num((+), negate) ) -import IntervalAlgebra ( - Interval - , Intervallic(unsafeInterval) - , IntervalSizeable(add)) +import IntervalAlgebra (Interval, IntervalSizeable(beginerval)) import Data.Time as DT ( Day(ModifiedJulianDay), toModifiedJulianDay) instance Arbitrary (Interval Int) where - arbitrary = liftM2 safeInterval' arbitrary arbitrary + arbitrary = liftM2 beginerval arbitrary arbitrary instance Arbitrary DT.Day where arbitrary = DT.ModifiedJulianDay . (2000 +) <$> arbitrary shrink = (DT.ModifiedJulianDay <$>) . shrink . DT.toModifiedJulianDay instance Arbitrary (Interval DT.Day) where - arbitrary = liftM2 safeInterval' arbitrary arbitrary - -type IntervalInt = Interval Int - --- | Internal function for converting a number to a strictly positive value. -makePos :: (Ord b, Num b) => b -> b -makePos x - | x == 0 = x + 1 - | x < 0 = negate x - | otherwise = x - --- | A function for creating intervals when you think you know what you're doing. -safeInterval :: (Intervallic a) => a -> a -> Interval a -safeInterval x y = unsafeInterval (min x y) (max x y) - --- | Safely create a valid 'Interval a' from two @a@ by adding a positive @dur@ --- to @start@ to set the duration of the interval. -safeInterval' :: (IntervalSizeable a b) => a -> b -> Interval a -safeInterval' start dur = safeInterval start (add (makePos dur) start) - --- | Create a 'Maybe Interval a' from two @a@s. -safeInterval'' :: (Intervallic a) => a -> a -> Maybe (Interval a) -safeInterval'' x y - | y <= x = Nothing - | otherwise = Just $ safeInterval x y + arbitrary = liftM2 beginerval arbitrary arbitrary diff --git a/test/IntervalAlgebraSpec.hs b/test/IntervalAlgebraSpec.hs --- a/test/IntervalAlgebraSpec.hs +++ b/test/IntervalAlgebraSpec.hs @@ -3,18 +3,35 @@ module IntervalAlgebraSpec (spec) where -import Test.Hspec ( hspec, describe, it, Spec ) +import Test.Hspec ( hspec, describe, it, Spec, shouldBe ) import Test.Hspec.QuickCheck ( modifyMaxSuccess, modifyMaxDiscardRatio ) import Test.QuickCheck import IntervalAlgebra as IA import Data.Maybe -import Control.Monad -import IntervalAlgebra.Arbitrary +import Control.Monad () +import IntervalAlgebra.Arbitrary () import Data.Time as DT xor :: Bool -> Bool -> Bool xor a b = a /= b +-- | Internal function for converting a number to a strictly positive value. +makePos :: (Ord b, Num b) => b -> b +makePos x + | x == 0 = x + 1 + | x < 0 = negate x + | otherwise = x + +-- | A function for creating intervals when you think you know what you're doing. +safeInterval :: (Intervallic a) => a -> a -> Interval a +safeInterval x y = unsafeInterval (min x y) (max x y) + +-- | Create a 'Maybe Interval a' from two @a@s. +safeInterval'' :: (Intervallic a) => a -> a -> Maybe (Interval a) +safeInterval'' x y + | y <= x = Nothing + | otherwise = Just $ safeInterval x y + -- | A set used for testing M1 defined so that the M1 condition is true. data M1set a = M1set { m11 :: Interval a @@ -42,8 +59,8 @@ m1set :: (IntervalSizeable a b) => Interval a -> b -> b -> b -> M1set a m1set x a b c = M1set p1 p2 p3 p4 where p1 = x -- interval i in prop_IAaxiomM1 - p2 = safeInterval' (end x) a -- interval j in prop_IAaxiomM1 - p3 = safeInterval' (end x) b -- interval k in prop_IAaxiomM1 + p2 = beginerval a (end x) -- interval j in prop_IAaxiomM1 + p3 = beginerval b (end x) -- interval k in prop_IAaxiomM1 p4 = safeInterval (begin (expandl (makePos c) p2)) (begin p2) {- @@ -98,9 +115,9 @@ m2set :: (IntervalSizeable a b)=> Interval a -> Interval a -> b -> b -> M2set a m2set x y a b = M2set p1 p2 p3 p4 where p1 = x -- interval i in prop_IAaxiomM2 - p2 = safeInterval' (end x) a -- interval j in prop_IAaxiomM2 + p2 = beginerval a (end x) -- interval j in prop_IAaxiomM2 p3 = y -- interval k in prop_IAaxiomM2 - p4 = safeInterval' (end y) b -- interval l in prop_IAaxiomM2 + p4 = beginerval b (end y) -- interval l in prop_IAaxiomM2 {- @@ -269,7 +286,7 @@ m5set :: (IntervalSizeable a b)=> Interval a -> b -> b -> M5set a m5set x a b = M5set p1 p2 where p1 = x -- interval i in prop_IAaxiomM5 - p2 = safeInterval' ps a -- interval l in prop_IAaxiomM5 + p2 = beginerval a ps -- interval l in prop_IAaxiomM5 ps = end (expandr (makePos b) x) -- creating l by shifting and expanding i @@ -329,39 +346,31 @@ prop_IAstarts:: Interval a -> Interval a -> Property prop_IAstarts i j - | IA.starts i j = - let k = safeInterval (end i) (end j) - in - (j == (fromJust $ i .+. k)) === True - | otherwise = IA.starts i j === False + | IA.starts i j = (j == fromJust (i .+. k)) === True + | otherwise = IA.starts i j === False + where k = safeInterval (end i) (end j) prop_IAfinishes:: Interval a -> Interval a -> Property prop_IAfinishes i j - | IA.finishes i j = - let k = safeInterval (begin j) (begin i) - in - (j == (fromJust $ k .+. i)) === True - | otherwise = IA.finishes i j === False + | IA.finishes i j = (j == fromJust ( k .+. i)) === True + | otherwise = IA.finishes i j === False + where k = safeInterval (begin j) (begin i) prop_IAoverlaps:: Interval a -> Interval a -> Property prop_IAoverlaps i j - | IA.overlaps i j = - let k = safeInterval (begin i) (begin j) - l = safeInterval (begin j) (end i) - m = safeInterval (end i) (end j) - in - ((i == (fromJust $ k .+. l )) && - (j == (fromJust $ l .+. m ))) === True - | otherwise = IA.overlaps i j === False + | IA.overlaps i j = ((i == fromJust ( k .+. l )) && + (j == fromJust ( l .+. m ))) === True + | otherwise = IA.overlaps i j === False + where k = safeInterval (begin i) (begin j) + l = safeInterval (begin j) (end i) + m = safeInterval (end i) (end j) prop_IAduring:: Interval a -> Interval a-> Property prop_IAduring i j - | IA.during i j = - let k = safeInterval (begin j) (begin i) - l = safeInterval (end i) (end j) - in - (j == (fromJust $ (fromJust $ k .+. i) .+. l)) === True - | otherwise = IA.during i j === False + | IA.during i j = (j == fromJust ( fromJust (k .+. i) .+. l)) === True + | otherwise = IA.during i j === False + where k = safeInterval (begin j) (begin i) + l = safeInterval (end i) (end j) -- | For any two pair of intervals exactly one 'IntervalRelation' should hold prop_exclusiveRelations:: Interval a -> Interval a -> Property @@ -385,11 +394,24 @@ , IA.during , IA.contains ] - - spec :: Spec spec = do - describe "Interval Algebra Axioms for meets property" $ + describe "IntervalSizeable unit tests" $ + do + it "beginerval 2 10 should be Interval (10, 12)" $ + beginerval (2::Int) 10 `shouldBe` unsafeInterval (10::Int) (12::Int) + it "beginerval 0 10 should be Interval (10, 11)" $ + beginerval (0::Int) 10 `shouldBe` unsafeInterval (10::Int) (11::Int) + it "beginerval -2 10 should be Interval (10, 11)" $ + beginerval (-2::Int) 10 `shouldBe` unsafeInterval (10::Int) (11::Int) + it "enderval 2 10 should be Interval (8, 10)" $ + enderval (2::Int) 10 `shouldBe` unsafeInterval (8::Int) (10::Int) + it "enderval 0 10 should be Interval (9, 10)" $ + enderval (0::Int) 10 `shouldBe` unsafeInterval (9::Int) (10::Int) + it "enderval -2 10 should be Interval (9, 10)" $ + enderval (-2::Int) 10 `shouldBe` unsafeInterval (9::Int) (10::Int) + + describe "Interval Algebra Axioms for meets properties" $ modifyMaxSuccess (*10) $ do it "M1 Int" $ property prop_IAaxiomM1_Int