data-interval 2.1.1 → 2.1.2

raw patch · 14 files changed

+298/−225 lines, 14 filesdep −semigroupsdep −transformersdep ~basedep ~containersdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: semigroups, transformers

Dependency ranges changed: base, containers, deepseq, hashable, lattices, tasty-quickcheck

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +8/−0
• data-interval.cabal +16/−29
• src/Data/IntegerInterval.hs +14/−24
• src/Data/IntegerInterval/Internal.hs +1/−3
• src/Data/Interval.hs +13/−37
• src/Data/Interval/Internal.hs +10/−10
• src/Data/IntervalMap/Base.hs +9/−22
• src/Data/IntervalMap/Strict.hs +1/−4
• src/Data/IntervalRelation.hs +1/−1
• src/Data/IntervalSet.hs +31/−68
• test/TestIntegerInterval.hs +22/−5
• test/TestInterval.hs +3/−0
• test/TestIntervalMap.hs +0/−4
• test/TestIntervalSet.hs +169/−18

@@ -1,3 +1,11 @@+2.1.2+-----++* fix `Data.IntegerInterval.width` (#38, thanks to ncfavier)+* add `Data.IntegerInterval.memberCount` (#44, thanks to ncfavier)+* add `instance Ord` for `Interval`, `IntervalSet` and `IntervalMap` (#41, thanks to googleson78)+* fix `Data.IntervalSet.insert` (#43)+ 2.1.1 ----- 

@@ -1,11 +1,11 @@ Name:		data-interval-Version:	2.1.1+Version:	2.1.2 License:	BSD3 License-File:	COPYING Author:		Masahiro Sakai (masahiro.sakai@gmail.com) Maintainer:	masahiro.sakai@gmail.com Category:	Data, Math-Cabal-Version:	>= 1.10+Cabal-Version:	2.0 Synopsis:	Interval datatype, interval arithmetic and interval-based containers Description:    Interval datatype, interval arithmetic and interval-based containers for Haskell.@@ -13,26 +13,25 @@    this package provides both open and closed intervals and is intended to be used    with exact number types such as Rational and Integer. Bug-Reports:	https://github.com/msakai/data-interval/issues-Extra-Source-Files:+Extra-Doc-Files:    README.md-   COPYING    CHANGELOG.markdown Build-Type: Simple Tested-With:-   GHC ==7.8.4-   GHC ==7.10.3-   GHC ==8.0.2    GHC ==8.2.2    GHC ==8.4.4    GHC ==8.6.5    GHC ==8.8.4    GHC ==8.10.7-   GHC ==9.0.1-   GHC ==9.2.1+   GHC ==9.0.2+   GHC ==9.2.8+   GHC ==9.4.7+   GHC ==9.6.2+   GHC ==9.8.1  source-repository head   type:     git-  location: git://github.com/msakai/data-interval.git+  location: https://github.com/msakai/data-interval  flag lattices   description: Derive lattice instances@@ -41,20 +40,16 @@ Library   Hs-source-dirs: src   Build-Depends:-       base >=4 && <5-     , containers-     , deepseq+       base >=4.10 && <5+     , containers >= 0.5.8 && < 0.8+     , deepseq < 1.6      , hashable >=1.1.2.5 && <1.5      , extended-reals >=0.2 && <1.0-  if impl(ghc <8.0)-    Build-depends:-      semigroups   if flag(lattices)     build-depends:-     lattices >=1.2.1.1 && <2.1+     lattices >=2 && <2.3   Default-Language: Haskell2010   Other-Extensions:-     CPP      ScopedTypeVariables      TypeFamilies      DeriveDataTypeable@@ -95,22 +90,14 @@      , syb      , tasty >=0.10.1      , tasty-hunit >=0.9 && <0.11-     , tasty-quickcheck >=0.8 && <0.11+     , tasty-quickcheck >=0.8.1 && <0.11      , tasty-th      , HUnit      , QuickCheck >=2.5 && <3-  if impl(ghc >=8.0)-    Build-depends:-      quickcheck-classes-base-  if impl(ghc <8.0)-    Build-depends:-      semigroups-  if impl(ghc <7.10)-    Build-depends:-      transformers >=0.2+     , quickcheck-classes-base   if flag(lattices)     build-depends:-     lattices >=1.2.1.1 && <2.1+     lattices   Default-Language: Haskell2010   Other-Extensions:      TemplateHaskell

@@ -13,7 +13,7 @@ -- -- Interval datatype and interval arithmetic over integers. ----- Since 1.2.0+-- @since 1.2.0 -- -- For the purpose of abstract interpretation, it might be convenient to use -- 'Lattice' instance. See also lattices package@@ -50,6 +50,7 @@   , lowerBound'   , upperBound'   , width+  , memberCount    -- * Universal comparison operators   , (<!), (<=!), (==!), (>=!), (>!), (/=!)@@ -136,8 +137,6 @@     ub@_ -> (ub, Open)  #ifdef MIN_VERSION_lattices-#if MIN_VERSION_lattices(2,0,0)- instance Lattice IntegerInterval where   (\/) = hull   (/\) = intersection@@ -147,27 +146,7 @@  instance BoundedMeetSemiLattice IntegerInterval where   top = whole--#else--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- #endif-#endif  instance Show IntegerInterval where   showsPrec _ x | null x = showString "empty"@@ -305,9 +284,20 @@ width x   | null x = 0   | otherwise =-      case (upperBound x, lowerBound x) of+      case (lowerBound x, upperBound x) of         (Finite lb, Finite ub) -> ub - lb         _ -> error "Data.IntegerInterval.width: unbounded interval"++-- | How many integers lie within the (bounded) interval.+-- Equal to @Just (width + 1)@ for non-empty, bounded intervals.+-- The @memberCount@ of an unbounded interval is @Nothing@.+memberCount :: IntegerInterval -> Maybe Integer+memberCount x+  | null x = Just 0+  | otherwise =+      case (lowerBound x, upperBound x) of+        (Finite lb, Finite ub) -> Just (ub - lb + 1)+        _ -> Nothing  -- | pick up an element from the interval if the interval is not empty. pickup :: IntegerInterval -> Maybe Integer

@@ -1,9 +1,7 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, DeriveDataTypeable, LambdaCase #-}+{-# LANGUAGE DeriveDataTypeable, LambdaCase #-} {-# LANGUAGE Safe #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}-#endif  module Data.IntegerInterval.Internal   ( IntegerInterval

@@ -1,9 +1,7 @@ {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} {-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables #-} {-# LANGUAGE Safe #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Interval@@ -121,8 +119,6 @@ infix 4 /=??  #ifdef MIN_VERSION_lattices-#if MIN_VERSION_lattices(2,0,0)- instance (Ord r) => Lattice (Interval r) where   (\/) = hull   (/\) = intersection@@ -132,27 +128,7 @@  instance (Ord r) => BoundedMeetSemiLattice (Interval r) where   top = whole--#else--instance (Ord r) => JoinSemiLattice (Interval r) where-  join = hull--instance (Ord r) => MeetSemiLattice (Interval r) where-  meet = intersection--instance (Ord r) => Lattice (Interval r)--instance (Ord r) => BoundedJoinSemiLattice (Interval r) where-  bottom = empty--instance (Ord r) => BoundedMeetSemiLattice (Interval r) where-  top = whole--instance (Ord r) => BoundedLattice (Interval r)- #endif-#endif  instance (Ord r, Show r) => Show (Interval r) where   showsPrec _ x | null x = showString "empty"@@ -278,7 +254,7 @@  -- | intersection of a list of intervals. ----- Since 0.6.0+-- @since 0.6.0 intersections :: Ord r => [Interval r] -> Interval r intersections = foldl' intersection whole @@ -310,7 +286,7 @@  -- | convex hull of a list of intervals. ----- Since 0.6.0+-- @since 0.6.0 hulls :: Ord r => [Interval r] -> Interval r hulls = foldl' hull empty @@ -379,7 +355,7 @@  -- | Does the union of two range form a connected set? ----- Since 1.3.0+-- @since 1.3.0 isConnected :: Ord r => Interval r -> Interval r -> Bool isConnected x y   | null x = True@@ -426,7 +402,7 @@ -- -- (see also 'approxRational') ----- Since 0.4.0+-- @since 0.4.0 simplestRationalWithin :: RealFrac r => Interval r -> Maybe Rational simplestRationalWithin i | null i = Nothing simplestRationalWithin i@@ -483,7 +459,7 @@  -- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@? ----- Since 1.0.1+-- @since 1.0.1 (/=!) :: Ord r => Interval r -> Interval r -> Bool a /=! b = null $ a `intersection` b @@ -504,7 +480,7 @@  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@? ----- Since 1.0.0+-- @since 1.0.0 (<??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a <?? b = do   guard $ lowerBound a < upperBound b@@ -538,7 +514,7 @@  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@? ----- Since 1.0.0+-- @since 1.0.0 (<=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a <=?? b =   case pickup (intersection a b) of@@ -551,13 +527,13 @@  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@? ----- Since 1.0.0+-- @since 1.0.0 (==?) :: Ord 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+-- @since 1.0.0 (==??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a ==?? b = do   x <- pickup (intersection a b)@@ -565,13 +541,13 @@  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@? ----- Since 1.0.1+-- @since 1.0.1 (/=?) :: Ord 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+-- @since 1.0.1 (/=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) a /=?? b = do   guard $ not $ null a@@ -596,13 +572,13 @@  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@? ----- Since 1.0.0+-- @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+-- @since 1.0.0 (>??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r) (>??) = flip (<??) 

@@ -1,9 +1,7 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-} {-# LANGUAGE Safe #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}-#endif  module Data.Interval.Internal   ( Boundary(..)@@ -14,9 +12,6 @@   , empty   ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative hiding (empty)-#endif import Control.DeepSeq import Data.Data import Data.ExtendedReal@@ -40,7 +35,7 @@  instance Hashable Boundary --- | The intervals (/i.e./ connected and convex subsets) over real numbers __R__.+-- | The intervals (/i.e./ connected and convex subsets) over a type @r@. data Interval r   = Whole   | Empty@@ -55,7 +50,14 @@   | LeftOpen !r !r   | RightOpen !r !r   | BothOpen !r !r-  deriving (Eq, Typeable)+  deriving+    ( Eq+    , Ord+      -- ^ Note that this Ord is derived and not semantically meaningful.+      -- The primary intended use case is to allow using 'Interval'+      -- in maps and sets that require ordering.+    , Typeable+    )  peekInterval :: (Applicative m, Monad m, Ord r) => m Int8 -> m r -> m r -> m (Interval r) peekInterval tagM x y = do@@ -140,9 +142,7 @@   RightOpen _ q    -> (Finite q, Open)   BothOpen _ q     -> (Finite q, Open) -#if __GLASGOW_HASKELL__ >= 708 type role Interval nominal-#endif  instance (Ord r, Data r) => Data (Interval r) where   gfoldl k z x   = z interval `k` lowerBound' x `k` upperBound' x

@@ -1,9 +1,7 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-} {-# LANGUAGE Trustworthy #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.IntervalMap.Base@@ -104,16 +102,10 @@ import qualified Data.Interval as Interval import Data.IntervalSet (IntervalSet) import qualified Data.IntervalSet as IntervalSet-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((<$>))-import Data.Traversable (Traversable(..))-#endif #if __GLASGOW_HASKELL__ < 804 import Data.Monoid (Monoid(..)) #endif-#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts-#endif  -- ------------------------------------------------------------------------ -- The IntervalMap type@@ -123,11 +115,16 @@ -- Unlike 'IntervalSet', 'IntervalMap' never merge adjacent mappings, -- even if adjacent intervals are connected and mapped to the same value. newtype IntervalMap r a = IntervalMap (Map (LB r) (Interval r, a))-  deriving (Eq, Typeable)+  deriving+    ( Eq+    , Ord+      -- ^ Note that this Ord is derived and not semantically meaningful.+      -- The primary intended use case is to allow using 'IntervalSet'+      -- in maps and sets that require ordering.+    , Typeable+    ) -#if __GLASGOW_HASKELL__ >= 708 type role IntervalMap nominal representational-#endif  instance (Ord k, Show k, Show a) => Show (IntervalMap k a) where   showsPrec p (IntervalMap m) = showParen (p > appPrec) $@@ -170,27 +167,17 @@  instance Ord k => Monoid (IntervalMap k a) where   mempty = empty-  mappend = union+  mappend = (Semigroup.<>)   mconcat = unions  instance Ord k => Semigroup.Semigroup (IntervalMap k a) where   (<>)   = union-#if !defined(VERSION_semigroups)   stimes = Semigroup.stimesIdempotentMonoid-#else-#if MIN_VERSION_semigroups(0,17,0)-  stimes = Semigroup.stimesIdempotentMonoid-#else-  times1p _ a = a-#endif-#endif -#if __GLASGOW_HASKELL__ >= 708 instance Ord k => GHCExts.IsList (IntervalMap k a) where   type Item (IntervalMap k a) = (Interval k, a)   fromList = fromList   toList = toList-#endif  -- ------------------------------------------------------------------------ 

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, BangPatterns, TupleSections #-}+{-# LANGUAGE BangPatterns, TupleSections #-} {-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- |@@ -126,9 +126,6 @@ import qualified Data.IntervalSet as IntervalSet import Data.List (foldl') import qualified Data.Map.Strict as Map-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((<$>))-#endif  -- $strictness --

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} {-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- |

@@ -1,9 +1,7 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-} {-# LANGUAGE Trustworthy #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.IntervalSet@@ -80,19 +78,22 @@ #if __GLASGOW_HASKELL__ < 804 import Data.Monoid (Monoid(..)) #endif-#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts-#endif  -- | A set comprising zero or more non-empty, /disconnected/ intervals. -- -- Any connected intervals are merged together, and empty intervals are ignored. newtype IntervalSet r = IntervalSet (Map (Extended r) (Interval r))-  deriving (Eq, Typeable)+  deriving+    ( Eq+    , Ord+      -- ^ Note that this Ord is derived and not semantically meaningful.+      -- The primary intended use case is to allow using 'IntervalSet'+      -- in maps and sets that require ordering.+    , Typeable+    ) -#if __GLASGOW_HASKELL__ >= 708 type role IntervalSet nominal-#endif  instance (Ord r, Show r) => Show (IntervalSet r) where   showsPrec p (IntervalSet m) = showParen (p > appPrec) $@@ -134,8 +135,6 @@   hashWithSalt s (IntervalSet m) = hashWithSalt s (Map.toList m)  #ifdef MIN_VERSION_lattices-#if MIN_VERSION_lattices(2,0,0)- instance (Ord r) => Lattice (IntervalSet r) where   (\/) = union   (/\) = intersection@@ -145,44 +144,16 @@  instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where   top = whole--#else--instance (Ord r) => JoinSemiLattice (IntervalSet r) where-  join = union--instance (Ord r) => MeetSemiLattice (IntervalSet r) where-  meet = intersection--instance (Ord r) => Lattice (IntervalSet r)--instance (Ord r) => BoundedJoinSemiLattice (IntervalSet r) where-  bottom = empty--instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where-  top = whole--instance (Ord r) => BoundedLattice (IntervalSet r)- #endif-#endif  instance Ord r => Monoid (IntervalSet r) where   mempty = empty-  mappend = union+  mappend = (Semigroup.<>)   mconcat = unions  instance (Ord r) => Semigroup.Semigroup (IntervalSet r) where   (<>)    = union-#if !defined(VERSION_semigroups)   stimes  = Semigroup.stimesIdempotentMonoid-#else-#if MIN_VERSION_semigroups(0,17,0)-  stimes  = Semigroup.stimesIdempotentMonoid-#else-  times1p _ a = a-#endif-#endif  lift1   :: Ord r => (Interval r -> Interval r)@@ -225,12 +196,10 @@   fromRational r = singleton (fromRational r)   recip xs = lift1 recip (delete (Interval.singleton 0) xs) -#if __GLASGOW_HASKELL__ >= 708 instance Ord r => GHCExts.IsList (IntervalSet r) where   type Item (IntervalSet r) = Interval r   fromList = fromList   toList = toList-#endif  -- ----------------------------------------------------------------------- @@ -305,18 +274,24 @@ -- | Insert a new interval into the interval set. insert :: Ord r => Interval r -> IntervalSet r -> IntervalSet r insert i is | Interval.null i = is-insert i (IntervalSet is) = IntervalSet $-  case splitLookupLE (Interval.lowerBound i) is of-    (smaller, m1, xs) ->-      case splitLookupLE (Interval.upperBound i) xs of-        (_, m2, larger) ->-          Map.unions-          [ smaller-          , case fromList $ i : maybeToList m1 ++ maybeToList m2 of-              IntervalSet m -> m-          , larger-          ]+insert i (IntervalSet is) = IntervalSet $ Map.unions+  [ smaller'+  , case fromList $ i : maybeToList m0 ++ maybeToList m1 ++ maybeToList m2 of+      IntervalSet m -> m+  , larger+  ]+  where+    (smaller, m1, xs) = splitLookupLE (Interval.lowerBound i) is+    (_, m2, larger) = splitLookupLE (Interval.upperBound i) xs +    -- A tricky case is when an interval @i@ connects two adjacent+    -- members of IntervalSet, e. g., inserting {0} into (whole \\ {0}).+    (smaller', m0) = case Map.maxView smaller of+      Nothing -> (smaller, Nothing)+      Just (v, rest)+        | Interval.isConnected v i -> (rest, Just v)+      _ -> (smaller, Nothing)+ -- | Delete an interval from the interval set. delete :: Ord r => Interval r -> IntervalSet r -> IntervalSet r delete i is | Interval.null i = is@@ -403,23 +378,11 @@  splitLookupLE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v) splitLookupLE k m =-  case Map.splitLookup k m of-    (smaller, Just v, larger) -> (smaller, Just v, larger)-    (smaller, Nothing, larger) ->-      case Map.maxView smaller of-        Just (v, smaller') -> (smaller', Just v, larger)-        Nothing -> (smaller, Nothing, larger)--{--splitLookupGE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)-splitLookupGE k m =-  case Map.splitLookup k m of-    (smaller, Just v, larger) -> (smaller, Just v, larger)-    (smaller, Nothing, larger) ->-      case Map.minView larger of-        Just (v, larger') -> (smaller, Just v, larger')-        Nothing -> (smaller, Nothing, larger)--}+  case Map.spanAntitone (<= k) m of+    (lessOrEqual, greaterThan) ->+      case Map.maxView lessOrEqual of+        Just (v, lessOrEqual') -> (lessOrEqual', Just v, greaterThan)+        Nothing -> (lessOrEqual, Nothing, greaterThan)  compareLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering compareLB (lb1, lb1in) (lb2, lb2in) =

@@ -268,11 +268,28 @@ case_width_null =   IntegerInterval.width IntegerInterval.empty @?= 0 +case_width_positive =+  IntegerInterval.width (0 <=..< 10) @?= 9+ prop_width_singleton =   forAll arbitrary $ \x ->     IntegerInterval.width (IntegerInterval.singleton x) == 0  {--------------------------------------------------------------------+  memberCount+--------------------------------------------------------------------}++case_memberCount_null =+  IntegerInterval.memberCount IntegerInterval.empty @?= Just 0++case_memberCount_positive =+  IntegerInterval.memberCount (0 <=..< 10) @?= Just 10++prop_memberCount_singleton =+  forAll arbitrary $ \x ->+    IntegerInterval.memberCount (IntegerInterval.singleton x) == Just 1++{--------------------------------------------------------------------   map --------------------------------------------------------------------} @@ -682,35 +699,35 @@     ival1 :: IntegerInterval     ival1 = 1 <=..<= 2     ival2 = 1 <..< 2-    ival3 = IntegerInterval.empty -- *+    ival3 = IntegerInterval.empty  case_mult_test3 = ival1 * ival2 @?= ival3   where     ival1 :: IntegerInterval     ival1 = 1 <..< 2     ival2 = 1 <..< 2-    ival3 = IntegerInterval.empty -- *+    ival3 = IntegerInterval.empty  case_mult_test4 = ival1 * ival2 @?= ival3   where     ival1 :: IntegerInterval     ival1 = 2 <..< PosInf     ival2 = 3 <..< PosInf-    ival3 = 11 <..< PosInf -- *+    ival3 = 11 <..< PosInf  case_mult_test5 = ival1 * ival2 @?= ival3   where     ival1 :: IntegerInterval     ival1 = NegInf <..< (-3)     ival2 = NegInf <..< (-2)-    ival3 = 11 <..< PosInf -- *+    ival3 = 11 <..< PosInf  case_mult_test6 = ival1 * ival2 @?= ival3   where     ival1 :: IntegerInterval     ival1 = 2 <..< PosInf     ival2 = NegInf <..< (-2)-    ival3 = NegInf <..< (-8) -- *+    ival3 = NegInf <..< (-8)  prop_abs_signum =   forAll integerIntervals $ \a ->

@@ -322,6 +322,9 @@ case_width_null =   Interval.width Interval.empty @?= 0 +case_width_positive =+  Interval.width (0 <=..< 10) @?= 10+ prop_width_singleton =   forAll arbitrary $ \(r::Rational) ->     Interval.width (Interval.singleton r) == 0

@@ -10,10 +10,6 @@ import Data.Generics.Schemes import Data.Hashable import Data.Maybe-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((<$>))-import Data.Traversable (Traversable(..))-#endif #if __GLASGOW_HASKELL__ < 804 import Data.Semigroup ((<>)) #endif

@@ -5,10 +5,12 @@ import qualified Algebra.Lattice as L #endif import Control.Applicative ((<$>))+import Control.Arrow (first) import Control.DeepSeq import Control.Monad import Data.Generics.Schemes import Data.Hashable+import qualified Data.List as L import Data.Maybe import Data.Monoid import Data.Ratio@@ -62,6 +64,9 @@   forAll arbitrary $ \r1 ->     not $ IntervalSet.null $ fromRational (r1::Rational) +case_singleton_1 =+  IntervalSet.singleton Interval.empty @?= (IntervalSet.empty :: IntervalSet Rational)+ {--------------------------------------------------------------------   complement --------------------------------------------------------------------}@@ -82,6 +87,10 @@   fromList --------------------------------------------------------------------} +case_fromList_minus_one_to_one_without_zero = xs @?= xs+  where+    xs = show (IntervalSet.fromList [ (-1 <..< 0 :: Interval Rational), 0 <..<1 ])+ case_fromList_connected =   IntervalSet.fromList [ (0 <=..< 1 :: Interval Rational), 1 <=..<2 ]   @?= IntervalSet.fromList [ 0 <=..<2 ]@@ -110,6 +119,22 @@   IntervalSet.insert (1 <=..< 2 :: Interval Rational) (IntervalSet.fromList [ 0 <=..< 1, 2 <=..< 3 ])   @?= IntervalSet.singleton (0 <=..< 3) +case_insert_zero =+  IntervalSet.insert zero (IntervalSet.complement $ IntervalSet.singleton zero) @?= IntervalSet.whole+  where+    zero :: Interval Rational+    zero = 0 <=..<= 0++case_insert_zero_negative =+  IntervalSet.insert zero negative @?= nonPositive+  where+    zero :: Interval Rational+    zero = 0 <=..<= 0+    negative :: IntervalSet Rational+    negative = IntervalSet.singleton $ NegInf <..< 0+    nonPositive :: IntervalSet Rational+    nonPositive = IntervalSet.singleton $ NegInf <..<= 0+ {--------------------------------------------------------------------   delete --------------------------------------------------------------------}@@ -162,11 +187,22 @@   forAll arbitrary $ \(a :: IntervalSet Rational) ->     IntervalSet.intersection a IntervalSet.empty == IntervalSet.empty +prop_intersection_isSubsetOf_integer =+  forAll arbitrary $ \(a :: IntervalSet Integer) ->+  forAll arbitrary $ \b ->+    IntervalSet.isSubsetOf (IntervalSet.intersection a b) a+ prop_intersection_isSubsetOf =   forAll arbitrary $ \(a :: IntervalSet Rational) ->   forAll arbitrary $ \b ->     IntervalSet.isSubsetOf (IntervalSet.intersection a b) a +prop_intersection_isSubsetOf_equiv_integer =+  forAll arbitrary $ \(a :: IntervalSet Integer) ->+  forAll arbitrary $ \b ->+    (IntervalSet.intersection a b == a)+    == IntervalSet.isSubsetOf a b+ prop_intersection_isSubsetOf_equiv =   forAll arbitrary $ \(a :: IntervalSet Rational) ->   forAll arbitrary $ \b ->@@ -213,11 +249,22 @@   forAll arbitrary $ \(a :: IntervalSet Rational) ->     IntervalSet.union a IntervalSet.whole == IntervalSet.whole +prop_union_isSubsetOf_integer =+  forAll arbitrary $ \(a :: IntervalSet Integer) ->+  forAll arbitrary $ \b ->+    IntervalSet.isSubsetOf a (IntervalSet.union a b)+ prop_union_isSubsetOf =   forAll arbitrary $ \(a :: IntervalSet Rational) ->   forAll arbitrary $ \b ->     IntervalSet.isSubsetOf a (IntervalSet.union a b) +prop_union_isSubsetOf_equiv_integer =+  forAll arbitrary $ \(a :: IntervalSet Integer) ->+  forAll arbitrary $ \b ->+    (IntervalSet.union a b == b)+    == IntervalSet.isSubsetOf a b+ prop_union_isSubsetOf_equiv =   forAll arbitrary $ \(a :: IntervalSet Rational) ->   forAll arbitrary $ \b ->@@ -246,6 +293,10 @@   span --------------------------------------------------------------------} +prop_span_integer =+  forAll arbitrary $ \(a :: IntervalSet Integer) ->+    a `IntervalSet.isSubsetOf` IntervalSet.singleton (IntervalSet.span a)+ prop_span =   forAll arbitrary $ \(a :: IntervalSet Rational) ->     a `IntervalSet.isSubsetOf` IntervalSet.singleton (IntervalSet.span a)@@ -253,18 +304,98 @@ case_span_empty =   IntervalSet.span IntervalSet.empty @?= (Interval.empty :: Interval Rational) +case_span_whole =+  IntervalSet.span IntervalSet.whole @?= (Interval.whole :: Interval Rational)++case_span_without_zero =+  IntervalSet.span (IntervalSet.complement $ IntervalSet.singleton $ 0 <=..<= 0) @?=+    (Interval.whole :: Interval Rational)++case_span_1 =+  IntervalSet.span (IntervalSet.fromList [0 <=..< 10, 20 <..< PosInf]) @?=+    0 <=..< PosInf+ {--------------------------------------------------------------------   member --------------------------------------------------------------------} +prop_member =+  forAll arbitrary $ \(r :: Rational) (is :: IntervalSet Rational) ->+    r `IntervalSet.member` is ==+      any (r `Interval.member`) (IntervalSet.toList is)++prop_member_empty =+  forAll arbitrary $ \(r :: Rational) ->+    not (r `IntervalSet.member` IntervalSet.empty)++prop_member_singleton =+  forAll arbitrary $ \(r1 :: Rational) (r2 :: Rational) ->+    r1 `IntervalSet.member` IntervalSet.singleton (Interval.singleton r2) ==+      (r1 == r2)+ prop_notMember_empty =-  forAll arbitrary $ \(r::Rational) ->+  forAll arbitrary $ \(r :: Rational) ->     r `IntervalSet.notMember` IntervalSet.empty  {--------------------------------------------------------------------   isSubsetOf --------------------------------------------------------------------} +case_isSubsetOf_1 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (NegInf <..<= 2)+    b = IntervalSet.singleton (NegInf <..<= 1)++case_isSubsetOf_2 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (1 <=..< PosInf)+    b = IntervalSet.singleton (2 <=..< PosInf)++case_isSubsetOf_3 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <=..< 1)+    b = IntervalSet.singleton (2 <..< PosInf)++case_isSubsetOf_4 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <=..<= 1)+    b = IntervalSet.singleton (2 <..< PosInf)++case_isSubsetOf_5 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <..< 1)+    b = IntervalSet.singleton (2 <=..< PosInf)++case_isSubsetOf_6 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <..< 1)+    b = IntervalSet.singleton (2 <..< PosInf)++case_isSubsetOf_7 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <..<= 1)+    b = IntervalSet.fromList [NegInf <..<= 0, 1 <=..< PosInf]++case_isSubsetOf_8 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <..< 1)+    b = IntervalSet.fromList [NegInf <..< 0, 1 <=..< PosInf]++case_isSubsetOf_9 = IntervalSet.isSubsetOf a b @?= True+  where+    a = IntervalSet.singleton (-3 <..< 1)+    b = IntervalSet.singleton (-4 <..< 2)++case_isSubsetOf_10 = IntervalSet.isSubsetOf a b @?= True+  where+    a = IntervalSet.singleton (14 <=..<= 16)+    b = IntervalSet.singleton (-8 <=..< PosInf)++case_isSubsetOf_11 = IntervalSet.isSubsetOf a b @?= False+  where+    a = IntervalSet.singleton (0 <=..<= 1)+    b = IntervalSet.fromList [0 <=..<= 0, 1 <=..< PosInf]+ prop_isSubsetOf_reflexive =   forAll arbitrary $ \(a :: IntervalSet Rational) ->     a `IntervalSet.isSubsetOf` a@@ -273,6 +404,14 @@   forAll arbitrary $ \(a :: IntervalSet Rational) ->     not (a `IntervalSet.isProperSubsetOf` a) +prop_isSubsetOf_empty =+  forAll arbitrary $ \(a :: IntervalSet Rational) ->+    IntervalSet.empty `IntervalSet.isSubsetOf` a++prop_isSubsetOf_whole =+  forAll arbitrary $ \(a :: IntervalSet Rational) ->+    a `IntervalSet.isSubsetOf` IntervalSet.whole+ {--------------------------------------------------------------------   toList / fromList --------------------------------------------------------------------}@@ -281,6 +420,15 @@   forAll arbitrary $ \(a :: IntervalSet Rational) ->     IntervalSet.fromList (IntervalSet.toList a) == a +prop_fromAscList_toAscList_id =+  forAll arbitrary $ \(a :: IntervalSet Rational) ->+    IntervalSet.fromAscList (IntervalSet.toAscList a) == a++case_toDescList_simple = xs @?= xs+  where+    xs = IntervalSet.toDescList $+      IntervalSet.fromList [NegInf <..< Finite (-1), Finite 1 <..< PosInf]+ prop_toAscList_toDescList =   forAll arbitrary $ \(a :: IntervalSet Rational) ->     IntervalSet.toDescList a == reverse (IntervalSet.toAscList a)@@ -480,29 +628,32 @@ instance Arbitrary r => Arbitrary (Extended r) where   arbitrary =     oneof-    [ return NegInf-    , return PosInf-    , liftM Finite arbitrary+    [ pure NegInf+    , pure PosInf+    , fmap Finite arbitrary     ]  instance (Arbitrary r, Ord r) => Arbitrary (Interval r) where-  arbitrary = do-    lb <- arbitrary-    ub <- arbitrary-    return $ Interval.interval lb ub+  arbitrary =+    Interval.interval <$> arbitrary <*> arbitrary  instance (Arbitrary r, Ord r) => Arbitrary (IntervalSet r) where-  arbitrary =  do+  arbitrary = do+    tabStops <- L.sort <$> arbitrary+    let is = IntervalSet.fromList $ go tabStops     b <- arbitrary-    if b then-      return IntervalSet.whole-    else do-      xs <- IntervalSet.fromList <$> listOf arbitrary-      b2 <- arbitrary-      if b2 then-        return xs-      else-        return $ IntervalSet.complement xs+    pure $ if b then is else IntervalSet.complement is+    where+      go [] = []+      go [(x, LT)] = [Finite x <..< PosInf]+      go [(x, GT)] = [Finite x <=..< PosInf]+      go ((x, EQ) : rest) = Interval.singleton x : go rest+      go ((x, LT) : (y, LT) : rest) = (Finite x <..< Finite y) : go rest+      go ((x, LT) : (y, GT) : rest) = (Finite x <..<= Finite y) : go rest+      go ((x, GT) : (y, LT) : rest) = (Finite x <=..< Finite y) : go rest+      go ((x, GT) : (y, GT) : rest) = (Finite x <=..<= Finite y) : go rest+      go ((x, LT) : (y, EQ) : rest) = (Finite x <..< Finite y) : go ((y, LT) : rest)+      go ((x, GT) : (y, EQ) : rest) = (Finite x <=..< Finite y) : go ((y, LT) : rest)  intervals :: Gen (Interval Rational) intervals = arbitrary