data-interval 1.0.0 → 1.0.1

raw patch · 3 files changed

+124/−23 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• data-interval.cabal +1/−1
• src/Data/Interval.hs +86/−21
• test/TestInterval.hs +37/−1

@@ -1,5 +1,5 @@ Name:		data-interval-Version:	1.0.0+Version:	1.0.1 License:	BSD3 License-File:	COPYING Author:		Masahiro Sakai (masahiro.sakai@gmail.com)

@@ -50,13 +50,15 @@   , upperBound'   , width -  -- * Comparison operators-  , (<!), (<=!), (==!), (>=!), (>!)-  , (<?), (<=?), (==?), (>=?), (>?)+  -- * Universal comparison operators+  , (<!), (<=!), (==!), (>=!), (>!), (/=!) -  -- * Comparison operators that produce witnesses (experimental)-  , (<??), (<=??), (==??), (>=??), (>??)+  -- * Existential comparison operators+  , (<?), (<=?), (==?), (>=?), (>?), (/=?) +  -- * Existential comparison operators that produce witnesses (experimental)+  , (<??), (<=??), (==??), (>=??), (>??), (/=??)+   -- * Combine   , intersection   , intersections@@ -81,26 +83,38 @@ import Data.Ratio import Prelude hiding (null) --- | Interval+-- | The intervals (/i.e./ connected and convex subsets) over real numbers __R__. data Interval r = Interval !(EndPoint r, Bool) !(EndPoint r, Bool)   deriving (Eq, Typeable)   --- | Lower bound of the interval-lowerBound :: Num r => Interval r -> EndPoint r+-- | Lower endpoint (/i.e./ greatest lower bound)  of the interval.+--+-- * 'lowerBound' of the empty interval is 'PosInf'.+--+-- * 'lowerBound' of a left unbounded interval is 'NegInf'.+--+-- * 'lowerBound' of an interval may or may not be a member of the interval.+lowerBound :: Interval r -> EndPoint r lowerBound (Interval (lb,_) _) = lb --- | Upper bound of the interval-upperBound :: Num r => Interval r -> EndPoint r+-- | Upper endpoint (/i.e./ least upper bound) of the interval.+--+-- * 'upperBound' of the empty interval is 'NegInf'.+--+-- * 'upperBound' of a right unbounded interval is 'PosInf'.+-- +-- * 'upperBound' of an interval may or may not be a member of the interval.+upperBound :: Interval r -> EndPoint r upperBound (Interval _ (ub,_)) = ub --- | Lower bound of the interval and whether it is included in the interval.+-- | 'lowerBound' of the interval and whether it is included in the interval. -- The result is convenient to use as an argument for 'interval'.-lowerBound' :: Num r => Interval r -> (EndPoint r, Bool)+lowerBound' :: Interval r -> (EndPoint r, Bool) lowerBound' (Interval lb _) = lb --- | Upper bound of the interval and whether it is included in the interval.+-- | 'upperBound' of the interval and whether it is included in the interval. -- The result is convenient to use as an argument for 'interval'.-upperBound' :: Num r => Interval r -> (EndPoint r, Bool)+upperBound' :: Interval r -> (EndPoint r, Bool) upperBound' (Interval _ ub) = ub  instance NFData r => NFData (Interval r) where@@ -235,6 +249,8 @@       )  -- | intersection of a list of intervals.+--+-- Since 0.6.0 intersections :: (Ord r, Num r) => [Interval r] -> Interval r intersections xs = foldl' intersection whole xs @@ -263,6 +279,8 @@       )  -- | convex hull of a list of intervals.+--+-- Since 0.6.0 hulls :: (Ord r, Num r) => [Interval r] -> Interval r hulls xs = foldl' hull empty xs @@ -274,6 +292,10 @@     LT -> False     GT -> True +isSingleton :: Ord r => Interval r -> Bool+isSingleton (Interval (Finite l, True) (Finite u, True)) = l==u+isSingleton _ = False+ -- | Is the element in the interval? member :: Ord r => r -> Interval r -> Bool member x (Interval (x1,in1) (x2,in2)) = condLB && condUB@@ -286,7 +308,7 @@ notMember a i = not $ member a i  -- | Is this a subset?--- @(i1 `isSubsetOf` i2)@ tells whether @i1@ is a subset of @i2@.+-- @(i1 \``isSubsetOf`\` i2)@ tells whether @i1@ is a subset of @i2@. isSubsetOf :: Ord r => Interval r -> Interval r -> Bool isSubsetOf (Interval lb1 ub1) (Interval lb2 ub2) = testLB lb1 lb2 && testUB ub1 ub2   where@@ -301,7 +323,7 @@         GT -> False         EQ -> not in1 || in2 -- in1 => in2 --- | Is this a proper subset? (ie. a subset but not equal).+-- | Is this a proper subset? (/i.e./ a subset but not equal). isProperSubsetOf :: Ord r => Interval r -> Interval r -> Bool isProperSubsetOf i1 i2 = i1 /= i2 && i1 `isSubsetOf` i2 @@ -324,6 +346,7 @@ pickup _ = Nothing  -- | 'simplestRationalWithin' returns the simplest rational number within the interval.+--  -- A rational number @y@ is said to be /simpler/ than another @y'@ if -- -- * @'abs' ('numerator' y) <= 'abs' ('numerator' y')@, and@@ -332,6 +355,7 @@ --  -- (see also 'approxRational') --+-- Since 0.4.0 simplestRationalWithin :: RealFrac r => Interval r -> Maybe Rational simplestRationalWithin i | null i = Nothing simplestRationalWithin i @@ -354,7 +378,7 @@         condLB = if in1 then x1 <= Finite x' else x1 < Finite x'         condUB = if in2 then Finite x' <= x2 else Finite x' < x2 --- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@+-- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@? (<!) :: Real r => Interval r -> Interval r -> Bool a <! b =   case ub_a `compare` lb_b of@@ -369,19 +393,25 @@     (ub_a, in1) = upperBound' a     (lb_b, in2) = lowerBound' b --- | For all @x@ in @X@, @y@ in @Y@. @x '<=' y@+-- | For all @x@ in @X@, @y@ in @Y@. @x '<=' y@? (<=!) :: Real r => Interval r -> Interval r -> Bool a <=! b = upperBound a <= lowerBound b --- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@+-- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@? (==!) :: Real r => Interval r -> Interval r -> Bool a ==! b = a <=! b && a >=! b --- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@+-- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@?+--+-- Since 1.0.1+(/=!) :: Real r => Interval r -> Interval r -> Bool+a /=! b = null $ a `intersection` b++-- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@? (>=!) :: Real r => Interval r -> Interval r -> Bool (>=!) = flip (<=!) --- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@+-- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@? (>!) :: Real r => Interval r -> Interval r -> Bool (>!) = flip (<!) @@ -393,6 +423,8 @@     ub_b = upperBound b  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@?+--+-- Since 1.0.0 (<??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a <?? b = do   guard $ lowerBound a < upperBound b@@ -425,6 +457,8 @@     (ub_b, in2) = upperBound' b  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?+-- +-- Since 1.0.0 (<=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a <=?? b　= do   case pickup (intersection a b) of@@ -436,15 +470,42 @@       return (x,y)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?+-- +-- Since 1.0.0 (==?) :: Real r => Interval r -> Interval r -> Bool a ==? b = not $ null $ intersection a b  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?+--+-- Since 1.0.0 (==??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a ==?? b = do   x <- pickup (intersection a b)   return (x,x) +-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@?+--+-- Since 1.0.1+(/=?) :: Real r => Interval r -> Interval r -> Bool+a /=? b = not (null a) && not (null b) && not (a == b && isSingleton a)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@?+--+-- Since 1.0.1+(/=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)+a /=?? b = do+  guard $ not $ null a+  guard $ not $ null b+  guard $ not $ a == b && isSingleton a+  if not (isSingleton b)+    then f a b+    else liftM (\(y,x) -> (x,y)) $ f b a+  where+    f a b = do+      x <- pickup a+      y <- msum [pickup (b `intersection` c) | c <- [NegInf <..< Finite x, Finite x <..< PosInf]]+      return (x,y)+ -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@? (>=?) :: Real r => Interval r -> Interval r -> Bool (>=?) = flip (<=?)@@ -454,10 +515,14 @@ (>?) = flip (<?)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?+--+-- Since 1.0.0 (>=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) (>=??) = flip (<=??)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@?+--+-- Since 1.0.0 (>??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) (>??) = flip (<??) 

@@ -10,7 +10,12 @@ import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 -import Data.Interval (Interval, Extended (..), (<=..<=), (<=..<), (<..<=), (<..<), (<!), (<=!), (==!), (>=!), (>!), (<?), (<=?), (==?), (>=?), (>?), (<??), (<=??), (==??), (>=??), (>??))+import Data.Interval+  ( Interval, Extended (..), (<=..<=), (<=..<), (<..<=), (<..<)+  , (<!), (<=!), (==!), (>=!), (>!), (/=!)+  , (<?), (<=?), (==?), (>=?), (>?), (/=?)+  , (<??), (<=??), (==??), (>=??), (>??), (/=??)+  ) import qualified Data.Interval as Interval  {--------------------------------------------------------------------@@ -320,6 +325,9 @@ prop_le_some_refl =   forAll intervals $ \a -> not (Interval.null a) ==> a <=? a +prop_ne_all_not_refl =+  forAll intervals $ \a -> not (Interval.null a) ==> not (a /=! a)+ prop_lt_all_singleton =   forAll arbitrary $ \a ->   forAll arbitrary $ \b ->@@ -342,6 +350,15 @@   forAll arbitrary $ \a ->     Interval.singleton (a::Rational) ==! Interval.singleton a +prop_ne_all_singleton =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    (a::Rational) /= b ==> Interval.singleton a /=! Interval.singleton b++prop_ne_all_singleton_2 =+  forAll arbitrary $ \a ->+    not $ Interval.singleton (a::Rational) /=! Interval.singleton a+ prop_lt_some_singleton =   forAll arbitrary $ \a ->   forAll arbitrary $ \b ->@@ -379,6 +396,9 @@ prop_eq_all_empty =   forAll intervals $ \a -> a ==! Interval.empty +prop_ne_all_empty =+  forAll intervals $ \a -> a /=! Interval.empty+ prop_lt_some_empty =   forAll intervals $ \a -> not (a <? Interval.empty) @@ -436,6 +456,17 @@       Just (x,y) ->         Interval.member x a .&&. Interval.member y b .&&. x == y +prop_ne_some_witness =+  forAll intervals $ \a ->+  forAll intervals $ \b ->+    case a /=?? b of+      Nothing ->+        forAll arbitrary $ \x ->+        forAll arbitrary $ \y ->+          not (Interval.member x a && Interval.member y b && x /= y)+      Just (x,y) ->+        Interval.member x a .&&. Interval.member y b .&&. x /= y+ prop_le_some_witness_forget =   forAll intervals $ \a ->   forAll intervals $ \b ->@@ -450,6 +481,11 @@   forAll intervals $ \a ->   forAll intervals $ \b ->     isJust (a ==?? b) == (a ==? b)++prop_ne_some_witness_forget =+  forAll intervals $ \a ->+  forAll intervals $ \b ->+    isJust (a /=?? b) == (a /=? b)  {--------------------------------------------------------------------   Num