data-interval 1.1.1 → 1.2.0

raw patch · 7 files changed

+1273/−80 lines, 7 filesdep ~extended-realsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: extended-reals

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +6/−0
• README.md +1/−1
• data-interval.cabal +14/−3
• src/Data/IntegerInterval.hs +497/−0
• src/Data/Interval.hs +81/−65
• test/TestIntegerInterval.hs +660/−0
• test/TestInterval.hs +14/−11

@@ -1,3 +1,9 @@+1.2.0+-----+* add `Data.IntegerInterval`+* use extended-reals >=0.2+* `EndPoint` is deprecated. Use `Extended` instead.+ 1.1.1 ----- * remove unnecessary `Real` constraint from comparison operators.

@@ -1,7 +1,7 @@ data-interval ============= -[![Build Status](https://secure.travis-ci.org/msakai/data-interval.png?branch=master)](http://travis-ci.org/msakai/data-interval)+[![Build Status](https://secure.travis-ci.org/msakai/data-interval.png?branch=master)](http://travis-ci.org/msakai/data-interval) [![Hackage](https://budueba.com/hackage/data-interval)](https://hackage.haskell.org/package/data-interval)  Interval datatype and interval arithmetic for Haskell. 

@@ -1,5 +1,5 @@ Name:		data-interval-Version:	1.1.1+Version:	1.2.0 License:	BSD3 License-File:	COPYING Author:		Masahiro Sakai (masahiro.sakai@gmail.com)@@ -11,7 +11,7 @@    Interval datatype and interval arithmetic for Haskell.    Unlike the intervals package (<http://hackage.haskell.org/package/intervals>),    this package provides both open and closed intervals and is intended to be used-   with Rational.+   with exact number types such as Rational and Integer. Bug-Reports:	https://github.com/msakai/data-interval/issues Extra-Source-Files:    README.md@@ -27,18 +27,29 @@ Library   Hs-source-dirs: src   Build-Depends:-     base >=4 && <5, lattices >=1.2.1.1, deepseq, hashable >=1.1.2.5 && <1.3, extended-reals >=0.1 && <1.0+     base >=4 && <5, lattices >=1.2.1.1, deepseq, hashable >=1.1.2.5 && <1.3, extended-reals >=0.2 && <1.0   Default-Language: Haskell2010   Other-Extensions:      ScopedTypeVariables      DeriveDataTypeable   Exposed-Modules:      Data.Interval+     Data.IntegerInterval  Test-suite TestInterval   Type:              exitcode-stdio-1.0   HS-Source-Dirs:    test   Main-is:           TestInterval.hs+  Build-depends:     base >=4 && <5, containers, data-interval, test-framework, test-framework-th, test-framework-hunit, test-framework-quickcheck2 >=0.2.12.3, HUnit, QuickCheck >=2.5 && <3+  Default-Language: Haskell2010+  Other-Extensions:+     TemplateHaskell+     ScopedTypeVariables++Test-suite TestIntegerInterval+  Type:              exitcode-stdio-1.0+  HS-Source-Dirs:    test+  Main-is:           TestIntegerInterval.hs   Build-depends:     base >=4 && <5, containers, data-interval, test-framework, test-framework-th, test-framework-hunit, test-framework-quickcheck2 >=0.2.12.3, HUnit, QuickCheck >=2.5 && <3   Default-Language: Haskell2010   Other-Extensions:

@@ -0,0 +1,497 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.IntegerInterval+-- Copyright   :  (c) Masahiro Sakai 2011-2014+-- License     :  BSD-style+--+-- Maintainer  :  masahiro.sakai@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (ScopedTypeVariables, DeriveDataTypeable)+--+-- Interval datatype and interval arithmetic over integers.+--+-- Since 1.2.0+--+-- For the purpose of abstract interpretation, it might be convenient to use+-- 'Lattice' instance. See also lattices package+-- (<http://hackage.haskell.org/package/lattices>).+--+-----------------------------------------------------------------------------+module Data.IntegerInterval+  (+  -- * Interval type+    IntegerInterval+  , module Data.ExtendedReal++  -- * Construction+  , interval+  , (<=..<=)+  , (<..<=)+  , (<=..<)+  , (<..<)+  , whole+  , empty+  , singleton++  -- * Query+  , null+  , member+  , notMember+  , isSubsetOf+  , isProperSubsetOf+  , lowerBound+  , upperBound+  , lowerBound'+  , upperBound'+  , width++  -- * Universal comparison operators+  , (<!), (<=!), (==!), (>=!), (>!), (/=!)++  -- * Existential comparison operators+  , (<?), (<=?), (==?), (>=?), (>?), (/=?)++  -- * Existential comparison operators that produce witnesses (experimental)+  , (<??), (<=??), (==??), (>=??), (>??), (/=??)++  -- * Combine+  , intersection+  , intersections+  , hull+  , hulls++  -- * Operations+  , pickup+  , simplestIntegerWithin++  -- * Conversion+  , toInterval+  , fromInterval+  , fromIntervalOver+  , fromIntervalUnder+  ) where++import Algebra.Lattice+import Control.DeepSeq+import Control.Exception (assert)+import Control.Monad hiding (join)+import Data.Data+import Data.ExtendedReal+import Data.Hashable+import Data.List hiding (null)+import Data.Maybe+import Prelude hiding (null)+import qualified Data.Interval as Interval++infix 5 <=..<=+infix 5 <..<=+infix 5 <=..<+infix 5 <..<+infix 4 <!+infix 4 <=!+infix 4 ==!+infix 4 >=!+infix 4 >!+infix 4 /=!+infix 4 <?+infix 4 <=?+infix 4 ==?+infix 4 >=?+infix 4 >?+infix 4 /=?+infix 4 <??+infix 4 <=??+infix 4 ==??+infix 4 >=??+infix 4 >??+infix 4 /=??++-- | The intervals (/i.e./ connected and convex subsets) over integers (__Z__).+data IntegerInterval = Interval !(Extended Integer) !(Extended Integer)+  deriving (Eq, Typeable)++-- | 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 :: IntegerInterval -> Extended Integer+lowerBound (Interval lb _) = lb++-- | 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 is a member of the interval.+upperBound :: IntegerInterval -> Extended Integer+upperBound (Interval _ ub) = ub++-- | 'lowerBound' of the interval and whether it is included in the interval.+-- The result is convenient to use as an argument for 'interval'.+lowerBound' :: IntegerInterval -> (Extended Integer, Bool)+lowerBound' (Interval lb@(Finite _)  _) = (lb, True)+lowerBound' (Interval lb  _) = (lb, False)++-- | 'upperBound' of the interval and whether it is included in the interval.+-- The result is convenient to use as an argument for 'interval'.+upperBound' :: IntegerInterval -> (Extended Integer, Bool)+upperBound' (Interval _ ub@(Finite _)) = (ub, True)+upperBound' (Interval _ ub) = (ub, False)++instance NFData IntegerInterval where+  rnf (Interval lb ub) = rnf lb `seq` rnf ub++instance Hashable IntegerInterval where+  hashWithSalt s (Interval lb ub) = s `hashWithSalt` lb `hashWithSalt` ub++instance JoinSemiLattice IntegerInterval where+  join = hull++instance MeetSemiLattice IntegerInterval where+  meet = intersection++instance Lattice IntegerInterval++instance BoundedJoinSemiLattice IntegerInterval where+  bottom = empty++instance BoundedMeetSemiLattice IntegerInterval where+  top = whole++instance BoundedLattice IntegerInterval++instance Show IntegerInterval where+  showsPrec _ x | null x = showString "empty"+  showsPrec p x = showParen (p > appPrec) $+    showString "interval " .+    showsPrec (appPrec+1) (lowerBound' x) .+    showChar ' ' .+    showsPrec (appPrec+1) (upperBound' x)++instance Read IntegerInterval where+  readsPrec p r =+    (readParen (p > appPrec) $ \s0 -> do+      ("interval",s1) <- lex s0+      (lb,s2) <- readsPrec (appPrec+1) s1+      (ub,s3) <- readsPrec (appPrec+1) s2+      return (interval lb ub, s3)) r+    +++    (do ("empty", s) <- lex r+        return (empty, s))++-- This instance preserves data abstraction at the cost of inefficiency.+-- We omit reflection services for the sake of data abstraction.++instance Data IntegerInterval where+  gfoldl k z x   = z (<=..<=) `k` lowerBound x `k` upperBound x+  toConstr _     = error "toConstr"+  gunfold _ _    = error "gunfold"+  dataTypeOf _   = mkNoRepType "Data.IntegerInterval"++-- | smart constructor for 'Interval'+interval+  :: (Extended Integer, Bool) -- ^ lower bound and whether it is included+  -> (Extended Integer, Bool) -- ^ upper bound and whether it is included+  -> IntegerInterval+interval (x1,in1) (x2,in2) =+  (if in1 then x1 else x1 + 1) <=..<= (if in2 then x2 else x2 - 1)++-- | closed interval [@l@,@u@]+(<=..<=)+  :: Extended Integer -- ^ lower bound @l@+  -> Extended Integer -- ^ upper bound @u@+  -> IntegerInterval+(<=..<=) PosInf _ = empty+(<=..<=) _ NegInf = empty+(<=..<=) lb ub+  | lb <= ub  = Interval lb ub+  | otherwise = empty++-- | left-open right-closed interval (@l@,@u@]+(<..<=)+  :: Extended Integer -- ^ lower bound @l@+  -> Extended Integer -- ^ upper bound @u@+  -> IntegerInterval+(<..<=) lb ub = (lb+1) <=..<= ub++-- | left-closed right-open interval [@l@, @u@)+(<=..<)+  :: Extended Integer -- ^ lower bound @l@+  -> Extended Integer -- ^ upper bound @u@+  -> IntegerInterval+(<=..<) lb ub = lb <=..<= ub-1++-- | open interval (@l@, @u@)+(<..<)+  :: Extended Integer -- ^ lower bound @l@+  -> Extended Integer -- ^ upper bound @u@+  -> IntegerInterval+(<..<) lb ub = lb+1 <=..<= ub-1++-- | whole real number line (-∞, ∞)+whole :: IntegerInterval+whole = Interval NegInf PosInf++-- | empty (contradicting) interval+empty :: IntegerInterval+empty = Interval PosInf NegInf++-- | singleton set \[x,x\]+singleton :: Integer -> IntegerInterval+singleton x = Finite x <=..<= Finite x++-- | intersection of two intervals+intersection :: IntegerInterval -> IntegerInterval -> IntegerInterval+intersection (Interval l1 u1) (Interval l2 u2) = max l1 l2 <=..<= min u1 u2++-- | intersection of a list of intervals.+intersections :: [IntegerInterval] -> IntegerInterval+intersections xs = foldl' intersection whole xs++-- | convex hull of two intervals+hull :: IntegerInterval -> IntegerInterval -> IntegerInterval+hull x1 x2+  | null x1 = x2+  | null x2 = x1+hull (Interval l1 u1) (Interval l2 u2) = min l1 l2 <=..<= max u1 u2++-- | convex hull of a list of intervals.+hulls :: [IntegerInterval] -> IntegerInterval+hulls xs = foldl' hull empty xs++-- | Is the interval empty?+null :: IntegerInterval -> Bool+null (Interval l u) = u < l++isSingleton :: IntegerInterval -> Bool+isSingleton (Interval l u) = l==u++-- | Is the element in the interval?+member :: Integer -> IntegerInterval -> Bool+member x (Interval l u) = l <= Finite x && Finite x <= u++-- | Is the element not in the interval?+notMember :: Integer -> IntegerInterval -> Bool+notMember a i = not $ member a i++-- | Is this a subset?+-- @(i1 \``isSubsetOf`\` i2)@ tells whether @i1@ is a subset of @i2@.+isSubsetOf :: IntegerInterval -> IntegerInterval -> Bool+isSubsetOf (Interval lb1 ub1) (Interval lb2 ub2) = lb2 <= lb1 && ub1 <= ub2++-- | Is this a proper subset? (/i.e./ a subset but not equal).+isProperSubsetOf :: IntegerInterval -> IntegerInterval -> Bool+isProperSubsetOf i1 i2 = i1 /= i2 && i1 `isSubsetOf` i2++-- | Width of a interval. Width of an unbounded interval is @undefined@.+width :: IntegerInterval -> Integer+width x | null x = 0+width (Interval (Finite l) (Finite u)) = u - l+width _ = error "Data.IntegerInterval.width: unbounded interval"++-- | pick up an element from the interval if the interval is not empty.+pickup :: IntegerInterval -> Maybe Integer+pickup (Interval NegInf PosInf) = Just 0+pickup (Interval (Finite l) _) = Just l+pickup (Interval _ (Finite u)) = Just u+pickup _ = Nothing++-- | 'simplestIntegerWithin' returns the simplest rational number within the interval.+--+-- An integer @y@ is said to be /simpler/ than another @y'@ if+--+-- * @'abs' y <= 'abs' y@, and+--+-- (see also 'approxRational')+simplestIntegerWithin :: IntegerInterval -> Maybe Integer+simplestIntegerWithin i+  | null i    = Nothing+  | 0 <! i    = Just $ let Finite x = lowerBound i in x+  | i <! 0    = Just $ let Finite x = upperBound i in x+  | otherwise = assert (0 `member` i) $ Just $ 0++-- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@?+(<!) :: IntegerInterval -> IntegerInterval -> Bool+--a <! b = upperBound a < lowerBound b+a <! b = a+1 <=! b++-- | For all @x@ in @X@, @y@ in @Y@. @x '<=' y@?+(<=!) :: IntegerInterval -> IntegerInterval -> Bool+a <=! b = upperBound a <= lowerBound b++-- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@?+(==!) :: IntegerInterval -> IntegerInterval -> Bool+a ==! b = a <=! b && a >=! b++-- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@?+(/=!) :: IntegerInterval -> IntegerInterval -> Bool+a /=! b = null $ a `intersection` b++-- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@?+(>=!) :: IntegerInterval -> IntegerInterval -> Bool+(>=!) = flip (<=!)++-- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@?+(>!) :: IntegerInterval -> IntegerInterval -> Bool+(>!) = flip (<!)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@?+(<?) :: IntegerInterval -> IntegerInterval -> Bool+a <? b = lowerBound a < upperBound b++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@?+(<??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)+a <?? b = do+  (x,y) <- a+1 <=?? b+  return (x-1,y)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?+(<=?) :: IntegerInterval -> IntegerInterval -> Bool+a <=? b =+  case lb_a `compare` ub_b of+    LT -> True+    GT -> False+    EQ ->+      case lb_a of+        NegInf -> False -- b is empty+        PosInf -> False -- a is empty+        Finite _ -> True+  where+    lb_a = lowerBound a+    ub_b = upperBound b++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?+(<=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)+a <=?? b = do+  case pickup (intersection a b) of+    Just x -> return (x,x)+    Nothing -> do+      guard $ upperBound a <= lowerBound b+      x <- pickup a+      y <- pickup b+      return (x,y)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?+(==?) :: IntegerInterval -> IntegerInterval -> Bool+a ==? b = not $ null $ intersection a b++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?+(==??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)+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@?+(/=?) :: IntegerInterval -> IntegerInterval -> 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@?+(/=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer,Integer)+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 <- [-inf <..< Finite x, Finite x <..< inf]]+      return (x,y)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?+(>=?) :: IntegerInterval -> IntegerInterval -> Bool+(>=?) = flip (<=?)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@?+(>?) :: IntegerInterval -> IntegerInterval -> Bool+(>?) = flip (<?)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?+(>=??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)+(>=??) = flip (<=??)++-- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@?+(>??) :: IntegerInterval -> IntegerInterval -> Maybe (Integer, Integer)+(>??) = flip (<??)++appPrec :: Int+appPrec = 10++scaleInterval :: Integer -> IntegerInterval -> IntegerInterval+scaleInterval _ x | null x = empty+scaleInterval c (Interval lb ub) =+  case compare c 0 of+    EQ -> singleton 0+    LT -> Finite c * ub <=..<= Finite c * lb+    GT -> Finite c * lb <=..<= Finite c * ub++instance Num IntegerInterval where+  a + b | null a || null b = empty+  Interval lb1 ub1 + Interval lb2 ub2 = lb1 + lb2 <=..<= ub1 + ub2++  negate a = scaleInterval (-1) a++  fromInteger i = singleton (fromInteger i)++  abs x = ((x `intersection` nonneg) `hull` (negate x `intersection` nonneg))+    where+      nonneg = 0 <=..< inf++  signum x = zero `hull` pos `hull` neg+    where+      zero = if member 0 x then singleton 0 else empty+      pos = if null $ (0 <..< inf) `intersection` x+            then empty+            else singleton 1+      neg = if null $ (-inf <..< 0) `intersection` x+            then empty+            else singleton (-1)++  a * b | null a || null b = empty+  Interval lb1 ub1 * Interval lb2 ub2 = minimum xs <=..<= maximum xs+    where+      xs = [ mul x1 x2 | x1 <- [lb1, ub1], x2 <- [lb2, ub2] ]++      mul :: Extended Integer -> Extended Integer -> Extended Integer+      mul 0 _ = 0+      mul _ 0 = 0+      mul x1 x2 = x1*x2++-- | Convert the interval to 'Interval.Interval' data type.+toInterval :: Real r => IntegerInterval -> Interval.Interval r+toInterval (Interval l u) = fmap fromInteger l Interval.<=..<= fmap fromInteger u++-- | Conversion from 'Interval.Interval' data type.+fromInterval :: Interval.Interval Integer -> IntegerInterval+fromInterval i = (if in1 then x1 else x1 + 1) <=..<= (if in2 then x2 else x2 - 1)+  where+    (x1,in1) = Interval.lowerBound' i+    (x2,in2) = Interval.upperBound' i++-- | Given a 'Interval.Interval' @I@ over R, compute the smallest 'IntegerInterval' @J@ such that @I ⊆ J@.+fromIntervalOver :: RealFrac r => Interval.Interval r -> IntegerInterval+fromIntervalOver i = fmap floor lb <=..<= fmap ceiling ub+  where+    lb = Interval.lowerBound i+    ub = Interval.upperBound i++-- | Given a 'Interval.Interval' @I@ over R, compute the largest 'IntegerInterval' @J@ such that @J ⊆ I@.+fromIntervalUnder :: RealFrac r => Interval.Interval r -> IntegerInterval+fromIntervalUnder i = fmap f lb <=..<= fmap g ub+  where+    lb = Interval.lowerBound i+    ub = Interval.upperBound i+    f x = if fromIntegral y `Interval.member` i then y else y+1+      where+        y = ceiling x+    g x = if fromIntegral y `Interval.member` i then y else y-1+      where+        y = floor x

@@ -5,7 +5,7 @@ -- Module      :  Data.Interval -- Copyright   :  (c) Masahiro Sakai 2011-2013 -- License     :  BSD-style--- +-- -- Maintainer  :  masahiro.sakai@gmail.com -- Stability   :  provisional -- Portability :  non-portable (ScopedTypeVariables, DeriveDataTypeable)@@ -19,13 +19,13 @@ -- For the purpose of abstract interpretation, it might be convenient to use -- 'Lattice' instance. See also lattices package -- (<http://hackage.haskell.org/package/lattices>).--- +-- ----------------------------------------------------------------------------- module Data.Interval   (   -- * Interval type     Interval-  , Extended (..)+  , module Data.ExtendedReal   , EndPoint    -- * Construction@@ -83,9 +83,32 @@ import Data.Ratio import Prelude hiding (null) +infix 5 <=..<=+infix 5 <..<=+infix 5 <=..<+infix 5 <..<+infix 4 <!+infix 4 <=!+infix 4 ==!+infix 4 >=!+infix 4 >!+infix 4 /=!+infix 4 <?+infix 4 <=?+infix 4 ==?+infix 4 >=?+infix 4 >?+infix 4 /=?+infix 4 <??+infix 4 <=??+infix 4 ==??+infix 4 >=??+infix 4 >??+infix 4 /=??+ -- | 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)  +data Interval r = Interval !(Extended r, Bool) !(Extended r, Bool)+  deriving (Eq, Typeable)  -- | Lower endpoint (/i.e./ greatest lower bound)  of the interval. --@@ -94,7 +117,7 @@ -- * '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 r -> Extended r lowerBound (Interval (lb,_) _) = lb  -- | Upper endpoint (/i.e./ least upper bound) of the interval.@@ -102,19 +125,19 @@ -- * '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 r -> Extended r upperBound (Interval _ (ub,_)) = ub  -- | 'lowerBound' of the interval and whether it is included in the interval. -- The result is convenient to use as an argument for 'interval'.-lowerBound' :: Interval r -> (EndPoint r, Bool)+lowerBound' :: Interval r -> (Extended r, Bool) lowerBound' (Interval lb _) = lb  -- | 'upperBound' of the interval and whether it is included in the interval. -- The result is convenient to use as an argument for 'interval'.-upperBound' :: Interval r -> (EndPoint r, Bool)+upperBound' :: Interval r -> (Extended r, Bool) upperBound' (Interval _ ub) = ub  instance NFData r => NFData (Interval r) where@@ -143,9 +166,9 @@   showsPrec _ x | null x = showString "empty"   showsPrec p x = showParen (p > appPrec) $     showString "interval " .-    showsPrec appPrec1 (lowerBound' x) .-    showChar ' ' . -    showsPrec appPrec1 (upperBound' x)+    showsPrec (appPrec+1) (lowerBound' x) .+    showChar ' ' .+    showsPrec (appPrec+1) (upperBound' x)  instance (Ord r, Read r) => Read (Interval r) where   readsPrec p r =@@ -171,8 +194,8 @@ -- | smart constructor for 'Interval' interval   :: (Ord r)-  => (EndPoint r, Bool) -- ^ lower bound and whether it is included -  -> (EndPoint r, Bool) -- ^ upper bound and whether it is included+  => (Extended r, Bool) -- ^ lower bound and whether it is included+  -> (Extended r, Bool) -- ^ upper bound and whether it is included   -> Interval r interval lb@(x1,in1) ub@(x2,in2) =   case x1 `compare` x2 of@@ -186,32 +209,32 @@ -- | closed interval [@l@,@u@] (<=..<=)   :: (Ord r)-  => EndPoint r -- ^ lower bound @l@-  -> EndPoint r -- ^ upper bound @u@+  => Extended r -- ^ lower bound @l@+  -> Extended r -- ^ upper bound @u@   -> Interval r (<=..<=) lb ub = interval (lb, True) (ub, True)  -- | left-open right-closed interval (@l@,@u@] (<..<=)   :: (Ord r)-  => EndPoint r -- ^ lower bound @l@-  -> EndPoint r -- ^ upper bound @u@+  => Extended r -- ^ lower bound @l@+  -> Extended r -- ^ upper bound @u@   -> Interval r (<..<=) lb ub = interval (lb, False) (ub, True)  -- | left-closed right-open interval [@l@, @u@) (<=..<)   :: (Ord r)-  => EndPoint r -- ^ lower bound @l@-  -> EndPoint r -- ^ upper bound @u@+  => Extended r -- ^ lower bound @l@+  -> Extended r -- ^ upper bound @u@   -> Interval r (<=..<) lb ub = interval (lb, True) (ub, False)  -- | open interval (@l@, @u@) (<..<)   :: (Ord r)-  => EndPoint r -- ^ lower bound @l@-  -> EndPoint r -- ^ upper bound @u@+  => Extended r -- ^ lower bound @l@+  -> Extended r -- ^ upper bound @u@   -> Interval r (<..<) lb ub = interval (lb, False) (ub, False) @@ -231,7 +254,7 @@ intersection :: forall r. Ord r => Interval r -> Interval r -> Interval r intersection (Interval l1 u1) (Interval l2 u2) = interval (maxLB l1 l2) (minUB u1 u2)   where-    maxLB :: (EndPoint r, Bool) -> (EndPoint r, Bool) -> (EndPoint r, Bool)+    maxLB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)     maxLB (x1,in1) (x2,in2) =       ( max x1 x2       , case x1 `compare` x2 of@@ -239,7 +262,7 @@           LT -> in2           GT -> in1       )-    minUB :: (EndPoint r, Bool) -> (EndPoint r, Bool) -> (EndPoint r, Bool)+    minUB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)     minUB (x1,in1) (x2,in2) =       ( min x1 x2       , case x1 `compare` x2 of@@ -261,7 +284,7 @@   | null x2 = x1 hull (Interval l1 u1) (Interval l2 u2) = interval (minLB l1 l2) (maxUB u1 u2)   where-    maxUB :: (EndPoint r, Bool) -> (EndPoint r, Bool) -> (EndPoint r, Bool)+    maxUB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)     maxUB (x1,in1) (x2,in2) =       ( max x1 x2       , case x1 `compare` x2 of@@ -269,7 +292,7 @@           LT -> in2           GT -> in1       )-    minLB :: (EndPoint r, Bool) -> (EndPoint r, Bool) -> (EndPoint r, Bool)+    minLB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)     minLB (x1,in1) (x2,in2) =       ( min x1 x2       , case x1 `compare` x2 of@@ -286,7 +309,7 @@  -- | Is the interval empty? null :: Ord r => Interval r -> Bool-null (Interval (x1,in1) (x2,in2)) = +null (Interval (x1,in1) (x2,in2)) =   case x1 `compare` x2 of     EQ -> assert (in1 && in2) False     LT -> False@@ -346,38 +369,31 @@ 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 -- -- * @'denominator' y <= 'denominator' y'@.--- +-- -- (see also 'approxRational') -- -- Since 0.4.0 simplestRationalWithin :: RealFrac r => Interval r -> Maybe Rational simplestRationalWithin i | null i = Nothing-simplestRationalWithin i -  | 0 <! i    = Just $ go i +simplestRationalWithin i+  | 0 <! i    = Just $ go i   | i <! 0    = Just $ - go (- i)   | otherwise = assert (0 `member` i) $ Just $ 0   where     go i-      | fromInteger lb_floor       `member'` i = fromInteger lb_floor-      | fromInteger (lb_floor + 1) `member'` i = fromInteger (lb_floor + 1)+      | fromInteger lb_floor       `member` i = fromInteger lb_floor+      | fromInteger (lb_floor + 1) `member` i = fromInteger (lb_floor + 1)       | otherwise = fromInteger lb_floor + recip (go (recip (i - singleton (fromInteger lb_floor))))       where         Finite lb = lowerBound i         lb_floor  = floor lb -    member' :: (Real r, Fractional r) => Rational -> Interval r -> Bool-    member' x (Interval (x1,in1) (x2,in2)) = condLB && condUB-      where-        x' = fromRational x-        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@? (<!) :: Ord r => Interval r -> Interval r -> Bool a <! b =@@ -436,9 +452,9 @@       return (x,y)     Just z -> do       let x:y:_ = take 2 $-                    maybeToList (pickup (intersection a (NegInf <..< Finite z))) +++                    maybeToList (pickup (intersection a (-inf <..< Finite z))) ++                     [z] ++-                    maybeToList (pickup (intersection b (Finite z <..< PosInf)))+                    maybeToList (pickup (intersection b (Finite z <..< inf)))       return (x,y)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?@@ -447,7 +463,7 @@   case lb_a `compare` ub_b of     LT -> True     GT -> False-    EQ -> +    EQ ->       case lb_a of         NegInf -> False -- b is empty         PosInf -> False -- a is empty@@ -457,7 +473,7 @@     (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@@ -470,7 +486,7 @@       return (x,y)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?--- +-- -- Since 1.0.0 (==?) :: Ord r => Interval r -> Interval r -> Bool a ==? b = not $ null $ intersection a b@@ -503,7 +519,7 @@   where     f a b = do       x <- pickup a-      y <- msum [pickup (b `intersection` c) | c <- [NegInf <..< Finite x, Finite x <..< PosInf]]+      y <- msum [pickup (b `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]       return (x,y)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?@@ -526,9 +542,8 @@ (>??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) (>??) = flip (<??) -appPrec, appPrec1 :: Int+appPrec :: Int appPrec = 10-appPrec1 = appPrec + 1  scaleInterval :: (Num r, Ord r) => r -> Interval r -> Interval r scaleInterval _ x | null x = empty@@ -543,13 +558,13 @@   Interval lb1 ub1 + Interval lb2 ub2 = interval (f lb1 lb2) (g ub1 ub2)     where       f (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 && in2)-      f (NegInf,_) _ = (NegInf, False)-      f _ (NegInf,_) = (NegInf, False)+      f (NegInf,_) _ = (-inf, False)+      f _ (NegInf,_) = (-inf, False)       f _ _ = error "Interval.(+) should not happen"        g (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 && in2)-      g (PosInf,_) _ = (PosInf, False)-      g _ (PosInf,_) = (PosInf, False)+      g (PosInf,_) _ = (inf, False)+      g _ (PosInf,_) = (inf, False)       g _ _ = error "Interval.(+) should not happen"    negate a = scaleInterval (-1) a@@ -558,15 +573,15 @@    abs x = ((x `intersection` nonneg) `hull` (negate x `intersection` nonneg))     where-      nonneg = 0 <=..< PosInf+      nonneg = 0 <=..< inf    signum x = zero `hull` pos `hull` neg     where       zero = if member 0 x then singleton 0 else empty-      pos = if null $ (0 <..< PosInf) `intersection` x+      pos = if null $ (0 <..< inf) `intersection` x             then empty             else singleton 1-      neg = if null $ (NegInf <..< 0) `intersection` x+      neg = if null $ (-inf <..< 0) `intersection` x             then empty             else singleton (-1) @@ -587,40 +602,41 @@       lb3 = minimumBy cmpLB xs       xs = [recipLB lb, recipUB ub] -cmpUB, cmpLB :: Ord r => (EndPoint r, Bool) -> (EndPoint r, Bool) -> Ordering+cmpUB, cmpLB :: Ord r => (Extended r, Bool) -> (Extended r, Bool) -> Ordering cmpUB (x1,in1) (x2,in2) = compare x1 x2 `mappend` compare in1 in2 cmpLB (x1,in1) (x2,in2) = compare x1 x2 `mappend` flip compare in1 in2 +{-# DEPRECATED EndPoint "EndPoint is deprecated. Please use Extended instead." #-} -- | Endpoints of intervals type EndPoint r = Extended r -scaleInf' :: (Num r, Ord r) => r -> (EndPoint r, Bool) -> (EndPoint r, Bool)+scaleInf' :: (Num r, Ord r) => r -> (Extended r, Bool) -> (Extended r, Bool) scaleInf' a (x1, in1) = (scaleEndPoint a x1, in1) -scaleEndPoint :: (Num r, Ord r) => r -> EndPoint r -> EndPoint r-scaleEndPoint a inf =+scaleEndPoint :: (Num r, Ord r) => r -> Extended r -> Extended r+scaleEndPoint a e =   case a `compare` 0 of     EQ -> 0     GT ->-      case inf of+      case e of         NegInf   -> NegInf         Finite b -> Finite (a*b)         PosInf   -> PosInf     LT ->-      case inf of+      case e of         NegInf   -> PosInf         Finite b -> Finite (a*b)         PosInf   -> NegInf -mulInf' :: (Num r, Ord r) => (EndPoint r, Bool) -> (EndPoint r, Bool) -> (EndPoint r, Bool)+mulInf' :: (Num r, Ord r) => (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool) mulInf' (0, True) _ = (0, True) mulInf' _ (0, True) = (0, True) mulInf' (x1,in1) (x2,in2) = (x1*x2, in1 && in2) -recipLB :: (Fractional r, Ord r) => (EndPoint r, Bool) -> (EndPoint r, Bool)+recipLB :: (Fractional r, Ord r) => (Extended r, Bool) -> (Extended r, Bool) recipLB (0, _) = (PosInf, False) recipLB (x1, in1) = (recip x1, in1) -recipUB :: (Fractional r, Ord r) => (EndPoint r, Bool) -> (EndPoint r, Bool)+recipUB :: (Fractional r, Ord r) => (Extended r, Bool) -> (Extended r, Bool) recipUB (0, _) = (NegInf, False) recipUB (x1, in1) = (recip x1, in1)

@@ -0,0 +1,660 @@+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}+import Control.Monad+import Data.Maybe+import Data.Ratio+import Test.HUnit hiding (Test)+import Test.QuickCheck+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.TH+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2++import Data.IntegerInterval+  ( IntegerInterval, Extended (..), (<=..<=), (<=..<), (<..<=), (<..<)+  , (<!), (<=!), (==!), (>=!), (>!), (/=!)+  , (<?), (<=?), (==?), (>=?), (>?), (/=?)+  , (<??), (<=??), (==??), (>=??), (>??), (/=??)+  )+import qualified Data.IntegerInterval as IntegerInterval+import Data.Interval (Interval)+import qualified Data.Interval as Interval++{--------------------------------------------------------------------+  empty+--------------------------------------------------------------------}++prop_empty_is_bottom =+  forAll integerIntervals $ \a ->+    IntegerInterval.isSubsetOf IntegerInterval.empty a++prop_null_empty =+  forAll integerIntervals $ \a ->+    IntegerInterval.null a == (a == IntegerInterval.empty)++case_null_empty =+  IntegerInterval.null (IntegerInterval.empty :: IntegerInterval) @?= True++{--------------------------------------------------------------------+  whole+--------------------------------------------------------------------}++prop_whole_is_top =+  forAll integerIntervals $ \a ->+    IntegerInterval.isSubsetOf a IntegerInterval.whole++case_nonnull_top =+  IntegerInterval.null (IntegerInterval.whole :: IntegerInterval) @?= False++{--------------------------------------------------------------------+  singleton+--------------------------------------------------------------------}++prop_singleton_member =+  forAll arbitrary $ \r ->+    IntegerInterval.member (r::Integer) (IntegerInterval.singleton r)++prop_singleton_member_intersection =+  forAll integerIntervals $ \a ->+  forAll arbitrary $ \r ->+    let b = IntegerInterval.singleton r+    in IntegerInterval.member (r::Integer) a+       ==> IntegerInterval.intersection a b == b++prop_singleton_nonnull =+  forAll arbitrary $ \r1 ->+    not $ IntegerInterval.null $ IntegerInterval.singleton (r1::Integer)++prop_distinct_singleton_intersection =+  forAll arbitrary $ \r1 ->+  forAll arbitrary $ \r2 ->+    (r1::Integer) /= r2 ==>+      IntegerInterval.intersection (IntegerInterval.singleton r1) (IntegerInterval.singleton r2)+      == IntegerInterval.empty++{--------------------------------------------------------------------+  Intersection+--------------------------------------------------------------------}++prop_intersection_comm =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    IntegerInterval.intersection a b == IntegerInterval.intersection b a++prop_intersection_assoc =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+  forAll integerIntervals $ \c ->+    IntegerInterval.intersection a (IntegerInterval.intersection b c) ==+    IntegerInterval.intersection (IntegerInterval.intersection a b) c++prop_intersection_unitL =+  forAll integerIntervals $ \a ->+    IntegerInterval.intersection IntegerInterval.whole a == a++prop_intersection_unitR =+  forAll integerIntervals $ \a ->+    IntegerInterval.intersection a IntegerInterval.whole == a++prop_intersection_empty =+  forAll integerIntervals $ \a ->+    IntegerInterval.intersection a IntegerInterval.empty == IntegerInterval.empty++prop_intersection_isSubsetOf =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    IntegerInterval.isSubsetOf (IntegerInterval.intersection a b) a++prop_intersection_isSubsetOf_equiv =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    (IntegerInterval.intersection a b == a)+    == IntegerInterval.isSubsetOf a b++case_intersections_empty_list = IntegerInterval.intersections [] @?= (IntegerInterval.whole :: IntegerInterval)++prop_intersections_singleton_list =+  forAll integerIntervals $ \a -> IntegerInterval.intersections [a] == a++prop_intersections_two_elems =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    IntegerInterval.intersections [a,b] == IntegerInterval.intersection a b++{--------------------------------------------------------------------+  Hull+--------------------------------------------------------------------}++prop_hull_comm =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    IntegerInterval.hull a b == IntegerInterval.hull b a++prop_hull_assoc =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+  forAll integerIntervals $ \c ->+    IntegerInterval.hull a (IntegerInterval.hull b c) ==+    IntegerInterval.hull (IntegerInterval.hull a b) c++prop_hull_unitL =+  forAll integerIntervals $ \a ->+    IntegerInterval.hull IntegerInterval.empty a == a++prop_hull_unitR =+  forAll integerIntervals $ \a ->+    IntegerInterval.hull a IntegerInterval.empty == a++prop_hull_whole =+  forAll integerIntervals $ \a ->+    IntegerInterval.hull a IntegerInterval.whole == IntegerInterval.whole++prop_hull_isSubsetOf =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    IntegerInterval.isSubsetOf a (IntegerInterval.hull a b)++prop_hull_isSubsetOf_equiv =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    (IntegerInterval.hull a b == b)+    == IntegerInterval.isSubsetOf a b++case_hulls_empty_list = IntegerInterval.hulls [] @?= (IntegerInterval.empty :: IntegerInterval)++prop_hulls_singleton_list =+  forAll integerIntervals $ \a -> IntegerInterval.hulls [a] == a++prop_hulls_two_elems =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    IntegerInterval.hulls [a,b] == IntegerInterval.hull a b++{--------------------------------------------------------------------+  member+--------------------------------------------------------------------}++prop_member_isSubsetOf =+  forAll arbitrary $ \r ->+  forAll integerIntervals $ \a ->+    IntegerInterval.member r a == IntegerInterval.isSubsetOf (IntegerInterval.singleton r) a++{--------------------------------------------------------------------+  isSubsetOf+--------------------------------------------------------------------}++prop_isSubsetOf_refl =+  forAll integerIntervals $ \a ->+    IntegerInterval.isSubsetOf a a++prop_isSubsetOf_trans =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+  forAll integerIntervals $ \c ->+    IntegerInterval.isSubsetOf a b && IntegerInterval.isSubsetOf b c+    ==> IntegerInterval.isSubsetOf a c++-- prop_isSubsetOf_antisym =+--   forAll integerIntervals $ \a ->+--   forAll integerIntervals $ \b ->+--     IntegerInterval.isSubsetOf a b && IntegerInterval.isSubsetOf b a+--     ==> a == b++{--------------------------------------------------------------------+  pickup+--------------------------------------------------------------------}++prop_pickup_member_null =+  forAll integerIntervals $ \a ->+    case IntegerInterval.pickup a of+      Nothing -> IntegerInterval.null a+      Just x -> IntegerInterval.member x a++case_pickup_empty =+  IntegerInterval.pickup (IntegerInterval.empty :: IntegerInterval) @?= Nothing++case_pickup_whole =+  isJust (IntegerInterval.pickup (IntegerInterval.whole :: IntegerInterval)) @?= True++{--------------------------------------------------------------------+  Comparison+--------------------------------------------------------------------}++case_lt_all_1 = (a <! b) @?= False+  where+    a, b :: IntegerInterval+    a = NegInf <..<= 0+    b = 0 <=..< PosInf++case_lt_all_2 = (a <! b) @?= True+  where+    a, b :: IntegerInterval+    a = NegInf <..< 0+    b = 0 <=..< PosInf++case_lt_all_3 = (a <! b) @?= True+  where+    a, b :: IntegerInterval+    a = NegInf <..<= 0+    b = 0 <..< PosInf++case_lt_all_4 = (a <! b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <=..< PosInf+    b = 1 <=..< PosInf++case_lt_some_1 = (a <? b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <=..< PosInf+    b = NegInf <..<= 0++case_lt_some_2 = (a <? b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <..< PosInf+    b = NegInf <..<= 0++case_lt_some_3 = (a <? b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <=..< PosInf+    b = NegInf <..< 0++case_lt_some_4 = (a <! b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <=..< PosInf+    b = 1 <=..< PosInf++case_le_some_1 = (a <=? b) @?= True+  where+    a, b :: IntegerInterval+    a = 0 <=..< PosInf+    b = NegInf <..<= 0++case_le_some_2 = (a <=? b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <..< PosInf+    b = NegInf <..<= 0++case_le_some_3 = (a <=? b) @?= False+  where+    a, b :: IntegerInterval+    a = 0 <=..< PosInf+    b = NegInf <..< 0++prop_lt_all_not_refl =+  forAll integerIntervals $ \a -> not (IntegerInterval.null a) ==> not (a <! a)++prop_le_some_refl =+  forAll integerIntervals $ \a -> not (IntegerInterval.null a) ==> a <=? a++prop_ne_all_not_refl =+  forAll integerIntervals $ \a -> not (IntegerInterval.null a) ==> not (a /=! a)++prop_lt_all_singleton =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    (a::Integer) < b ==> IntegerInterval.singleton a <! IntegerInterval.singleton b++prop_lt_all_singleton_2 =+  forAll arbitrary $ \a ->+    not $ IntegerInterval.singleton (a::Integer) <! IntegerInterval.singleton a++prop_le_all_singleton =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    (a::Integer) <= b ==> IntegerInterval.singleton a <=! IntegerInterval.singleton b++prop_le_all_singleton_2 =+  forAll arbitrary $ \a ->+    IntegerInterval.singleton (a::Integer) <=! IntegerInterval.singleton a++prop_eq_all_singleton =+  forAll arbitrary $ \a ->+    IntegerInterval.singleton (a::Integer) ==! IntegerInterval.singleton a++prop_ne_all_singleton =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    (a::Integer) /= b ==> IntegerInterval.singleton a /=! IntegerInterval.singleton b++prop_ne_all_singleton_2 =+  forAll arbitrary $ \a ->+    not $ IntegerInterval.singleton (a::Integer) /=! IntegerInterval.singleton a++prop_lt_some_singleton =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    (a::Integer) < b ==> IntegerInterval.singleton a <? IntegerInterval.singleton b++prop_lt_some_singleton_2 =+  forAll arbitrary $ \a ->+    not $ IntegerInterval.singleton (a::Integer) <? IntegerInterval.singleton a++prop_le_some_singleton =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    (a::Integer) <= b ==> IntegerInterval.singleton a <=? IntegerInterval.singleton b++prop_le_some_singleton_2 =+  forAll arbitrary $ \a ->+    IntegerInterval.singleton (a::Integer) <=? IntegerInterval.singleton a++prop_eq_some_singleton =+  forAll arbitrary $ \a ->+    IntegerInterval.singleton (a::Integer) ==? IntegerInterval.singleton a++prop_lt_all_empty =+  forAll integerIntervals $ \a -> a <! IntegerInterval.empty++prop_lt_all_empty_2 =+  forAll integerIntervals $ \a -> IntegerInterval.empty <! a++prop_le_all_empty =+  forAll integerIntervals $ \a -> a <=! IntegerInterval.empty++prop_le_all_empty_2 =+  forAll integerIntervals $ \a -> IntegerInterval.empty <=! a++prop_eq_all_empty =+  forAll integerIntervals $ \a -> a ==! IntegerInterval.empty++prop_ne_all_empty =+  forAll integerIntervals $ \a -> a /=! IntegerInterval.empty++prop_lt_some_empty =+  forAll integerIntervals $ \a -> not (a <? IntegerInterval.empty)++prop_lt_some_empty_2 =+  forAll integerIntervals $ \a -> not (IntegerInterval.empty <? a)++prop_le_some_empty =+  forAll integerIntervals $ \a -> not (a <=? IntegerInterval.empty)++prop_le_some_empty_2 =+  forAll integerIntervals $ \a -> not (IntegerInterval.empty <=? a)++prop_eq_some_empty =+  forAll integerIntervals $ \a -> not (a ==? IntegerInterval.empty)++prop_intersect_le_some =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    not (IntegerInterval.null (IntegerInterval.intersection a b))+    ==> a <=? b++prop_intersect_eq_some =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    not (IntegerInterval.null (IntegerInterval.intersection a b))+    ==> a ==? b++prop_le_some_witness =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    case a <=?? b of+      Nothing ->+        forAll arbitrary $ \(x,y) ->+          not (IntegerInterval.member x a && IntegerInterval.member y b && x <= y)+      Just (x,y) ->+        IntegerInterval.member x a .&&. IntegerInterval.member y b .&&. x <= y++prop_lt_some_witness =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    case a <?? b of+      Nothing ->+        forAll arbitrary $ \(x,y) ->+          not (IntegerInterval.member x a && IntegerInterval.member y b && x < y)+      Just (x,y) ->+        IntegerInterval.member x a .&&. IntegerInterval.member y b .&&. x < y++prop_eq_some_witness =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    case a ==?? b of+      Nothing ->+        forAll arbitrary $ \x ->+          not (IntegerInterval.member x a && IntegerInterval.member x b)+      Just (x,y) ->+        IntegerInterval.member x a .&&. IntegerInterval.member y b .&&. x == y++prop_ne_some_witness =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    case a /=?? b of+      Nothing ->+        forAll arbitrary $ \x ->+        forAll arbitrary $ \y ->+          not (IntegerInterval.member x a && IntegerInterval.member y b && x /= y)+      Just (x,y) ->+        IntegerInterval.member x a .&&. IntegerInterval.member y b .&&. x /= y++prop_le_some_witness_forget =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    isJust (a <=?? b) == (a <=? b)++prop_lt_some_witness_forget =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    isJust (a <?? b) == (a <? b)++prop_eq_some_witness_forget =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    isJust (a ==?? b) == (a ==? b)++prop_ne_some_witness_forget =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    isJust (a /=?? b) == (a /=? b)++{--------------------------------------------------------------------+  Num+--------------------------------------------------------------------}++prop_scale_empty =+  forAll arbitrary $ \r ->+    IntegerInterval.singleton (r::Integer) * IntegerInterval.empty == IntegerInterval.empty++prop_add_comm =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    a + b == b + a++prop_add_assoc =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+  forAll integerIntervals $ \c ->+    a + (b + c) == (a + b) + c++prop_add_unitL =+  forAll integerIntervals $ \a ->+    IntegerInterval.singleton 0 + a == a++prop_add_unitR =+  forAll integerIntervals $ \a ->+    a + IntegerInterval.singleton 0 == a++prop_add_member =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    and [ (x+y) `IntegerInterval.member` (a+b)+        | x <- maybeToList $ IntegerInterval.pickup a+        , y <- maybeToList $ IntegerInterval.pickup b+        ]++prop_mult_comm =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    a * b == b * a++prop_mult_assoc =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+  forAll integerIntervals $ \c ->+    a * (b * c) == (a * b) * c++prop_mult_unitL =+  forAll integerIntervals $ \a ->+    IntegerInterval.singleton 1 * a == a++prop_mult_unitR =+  forAll integerIntervals $ \a ->+    a * IntegerInterval.singleton 1 == a++prop_mult_dist =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+  forAll integerIntervals $ \c ->+    (a * (b + c)) `IntegerInterval.isSubsetOf` (a * b + a * c)++prop_mult_empty =+  forAll integerIntervals $ \a ->+    IntegerInterval.empty * a == IntegerInterval.empty++prop_mult_zero =+  forAll integerIntervals $ \a ->+    not (IntegerInterval.null a) ==> IntegerInterval.singleton 0 * a ==  IntegerInterval.singleton 0++prop_mult_member =+  forAll integerIntervals $ \a ->+  forAll integerIntervals $ \b ->+    and [ (x*y) `IntegerInterval.member` (a*b)+        | x <- maybeToList $ IntegerInterval.pickup a+        , y <- maybeToList $ IntegerInterval.pickup b+        ]++case_mult_test1 = ival1 * ival2 @?= ival3+  where+    ival1 :: IntegerInterval+    ival1 = 1 <=..<= 2+    ival2 = 1 <=..<= 2+    ival3 = 1 <=..<= 4++case_mult_test2 = ival1 * ival2 @?= ival3+  where+    ival1 :: IntegerInterval+    ival1 = 1 <=..<= 2+    ival2 = 1 <..< 2+    ival3 = IntegerInterval.empty -- *++case_mult_test3 = ival1 * ival2 @?= ival3+  where+    ival1 :: IntegerInterval+    ival1 = 1 <..< 2+    ival2 = 1 <..< 2+    ival3 = IntegerInterval.empty -- *++case_mult_test4 = ival1 * ival2 @?= ival3+  where+    ival1 :: IntegerInterval+    ival1 = 2 <..< PosInf+    ival2 = 3 <..< PosInf+    ival3 = 11 <..< PosInf -- *++case_mult_test5 = ival1 * ival2 @?= ival3+  where+    ival1 :: IntegerInterval+    ival1 = NegInf <..< (-3)+    ival2 = NegInf <..< (-2)+    ival3 = 11 <..< PosInf -- *++case_mult_test6 = ival1 * ival2 @?= ival3+  where+    ival1 :: IntegerInterval+    ival1 = 2 <..< PosInf+    ival2 = NegInf <..< (-2)+    ival3 = NegInf <..< (-8) -- *++{--------------------------------------------------------------------+  Read+--------------------------------------------------------------------}++prop_show_read_invariance =+  forAll integerIntervals $ \i -> do+    i == read (show i)++{--------------------------------------------------------------------+  Conversion between Interval and IntegerInterval+--------------------------------------------------------------------}++prop_fromInterval_toInterval =+  forAll integerIntervals $ \i ->+    IntegerInterval.fromInterval (IntegerInterval.toInterval i) == i++prop_fromIntervalOver_toInterval =+  forAll integerIntervals $ \i ->+    IntegerInterval.fromIntervalOver (IntegerInterval.toInterval i :: Interval Rational) == i++prop_fromIntervalUnder_toInterval =+  forAll integerIntervals $ \i ->+    IntegerInterval.fromIntervalUnder (IntegerInterval.toInterval i :: Interval Rational) == i++prop_fromIntervalOver_toInterval_adjoint =+  forAll intervals $ \a ->+    forAll integerIntervals $ \b ->+      IntegerInterval.fromIntervalOver a `IntegerInterval.isSubsetOf` b+      == a `Interval.isSubsetOf` IntegerInterval.toInterval b++prop_toInterval_fromIntervalUnder_adjoint =+  forAll integerIntervals $ \a ->+    forAll intervals $ \b ->+      IntegerInterval.toInterval a `Interval.isSubsetOf` b+      == a `IntegerInterval.isSubsetOf` IntegerInterval.fromIntervalUnder b++prop_toInterval_fromInterval =+  forAll arbitrary $ \(i :: Interval Integer) ->+    IntegerInterval.toInterval (IntegerInterval.fromInterval i) `Interval.isSubsetOf` i++{--------------------------------------------------------------------+  Generators+--------------------------------------------------------------------}++instance Arbitrary r => Arbitrary (Extended r) where+  arbitrary =+    oneof+    [ return NegInf+    , return PosInf+    , liftM Finite arbitrary+    ]++instance (Arbitrary r, Ord r) => Arbitrary (Interval.Interval r) where+  arbitrary = do+    lb <- arbitrary+    ub <- arbitrary+    return $ Interval.interval lb ub++instance Arbitrary IntegerInterval where+  arbitrary = do+    lb <- arbitrary+    ub <- arbitrary+    return $ IntegerInterval.interval lb ub++integerIntervals :: Gen IntegerInterval+integerIntervals = arbitrary++intervals :: Gen (Interval.Interval Rational)+intervals = arbitrary++pos :: IntegerInterval+pos = 0 <..< PosInf++neg :: IntegerInterval+neg = NegInf <..< 0++nonpos :: IntegerInterval+nonpos = NegInf <..<= 0++nonneg :: IntegerInterval+nonneg = 0 <=..< PosInf++------------------------------------------------------------------------+-- Test harness++main :: IO ()+main = $(defaultMainGenerator)

@@ -228,7 +228,7 @@  -- http://en.wikipedia.org/wiki/Best_rational_approximation#Best_rational_approximations case_simplestRationalWithin_test4 =-  Interval.simplestRationalWithin (Finite (3.14155 :: Rational) <..< Finite 3.14165) @?= Just (355/113) +  Interval.simplestRationalWithin (Finite (3.14155 :: Rational) <..< Finite 3.14165) @?= Just (355/113)  case_simplestRationalWithin_test5 =   Interval.simplestRationalWithin (Finite (1.1e-20 :: Rational) <..< Finite (1.2e-20)) @?= Just (1/83333333333333333334)@@ -415,14 +415,14 @@   forAll intervals $ \a -> not (a ==? Interval.empty)  prop_intersect_le_some =-  forAll intervals $ \a -> -  forAll intervals $ \b -> +  forAll intervals $ \a ->+  forAll intervals $ \b ->     not (Interval.null (Interval.intersection a b))     ==> a <=? b  prop_intersect_eq_some =-  forAll intervals $ \a -> -  forAll intervals $ \b -> +  forAll intervals $ \a ->+  forAll intervals $ \b ->     not (Interval.null (Interval.intersection a b))     ==> a ==? b @@ -551,7 +551,7 @@   forAll intervals $ \a ->     Interval.empty * a == Interval.empty -prop_mult_zero = +prop_mult_zero =   forAll intervals $ \a ->     not (Interval.null a) ==> Interval.singleton 0 * a ==  Interval.singleton 0 @@ -640,18 +640,21 @@ --------------------------------------------------------------------}  instance Arbitrary r => Arbitrary (Extended r) where-  arbitrary = +  arbitrary =     oneof     [ return NegInf     , return PosInf     , liftM Finite arbitrary     ] +instance (Arbitrary r, Ord r) => Arbitrary (Interval r) where+  arbitrary = do+    lb <- arbitrary+    ub <- arbitrary+    return $ Interval.interval lb ub+ intervals :: Gen (Interval Rational)-intervals = do-  lb <- arbitrary-  ub <- arbitrary-  return $ Interval.interval lb ub+intervals = arbitrary  pos :: Interval Rational pos = 0 <..< PosInf