range-set-list 0.1.1.0 → 0.1.2.0

raw patch · 12 files changed

+1678/−273 lines, 12 filesdep ~basedep ~containersdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +10/−6
• range-set-list.cabal +16/−5
• src/Data/RangeSet/IntMap.hs +338/−0
• src/Data/RangeSet/Internal.hs +202/−0
• src/Data/RangeSet/List.hs +187/−72
• src/Data/RangeSet/Map.hs +342/−0
• tests/IntMap.hs +164/−0
• tests/List.hs +165/−0
• tests/Map.hs +165/−0
• tests/SetAction.hs +81/−0
• tests/Tests.hs +4/−190

@@ -1,3 +1,7 @@+### 0.1.2.0++- Map implementations: `Data.RangeSet.IntMap` and `Data.RangeSet.Map`+ ### 0.1.1.0  - Add `Semigroup`, `NFData`, `Hashable` and `Typeable` instances

@@ -6,23 +6,27 @@ [![Stackage LTS 3](http://stackage.org/package/range-set-list/badge/lts-3)](http://stackage.org/lts-3/package/range-set-list) [![Stackage Nightly](http://stackage.org/package/range-set-list/badge/nightly)](http://stackage.org/nightly/package/range-set-list) -A trivial implementation of range sets.+A few trivial implementations of range sets. -You can find the package (and it's documentation) on [hackage](http://hackage.haskell.org/package/range-set-list).+You can find the package (and its documentation) on [hackage](http://hackage.haskell.org/package/range-set-list).  This module is intended to be imported qualified, to avoid name-clashes with Prelude functions, e.g.+clashes with Prelude functions, e.g.,  ```haskell import Data.RangeSet.List (RSet) import qualified Data.RangeSet.List as RSet ``` -The implementation of `RSet` is based on _list_.+This package contains two implementations of exactly the same interface, plus one specialization, all of which provide exactly the same behavior: +* "Data.RangeSet.List" implements the simplest `RSet` based on _list_. Set construction and manipulation is most efficient for this version, but lookups may require a full list traversal.+* "Data.RangeSet.Map" implements a slightly less simple `RSet` based on _map_. Construction and manipulation have more overhead in this version, but lookups are significantly faster, especially for large sets.+* "Data.RangeSet.IntMap" is simply a specialization of "Data.RangeSet.Map" to Ints based on IntMap.+ Compared to [`Data.Set`](http://hackage.haskell.org/package/containers-0.5.4.0/docs/Data-Set.html),-this module imposes also [`Enum`](http://hackage.haskell.org/package/base-4.6.0.1/docs/Prelude.html#t:Enum)-restriction for many functions.+this module also imposes an [`Enum`](http://hackage.haskell.org/package/base-4.6.0.1/docs/Prelude.html#t:Enum)+constraint for many functions. We must be able to identify consecutive elements to be able to _glue_ and _split_ ranges properly.  The implementation assumes that

@@ -3,9 +3,9 @@ -- see: https://github.com/sol/hpack  name:                range-set-list-version:             0.1.1.0-synopsis:            Memory efficient sets with continuous ranges of elements.-description:         Memory efficient sets with continuous ranges of elements. List based implementation. Interface mimics 'Data.Set' interface where possible.+version:             0.1.2.0+synopsis:            Memory efficient sets with ranges of elements.+description:         Memory efficient sets with continuous ranges of discrete, bounded elements. List- and map-based implementations. Interface mimics 'Data.Set' where possible. homepage:            https://github.com/phadej/range-set-list#readme bug-reports:         https://github.com/phadej/range-set-list/issues license:             MIT@@ -28,14 +28,19 @@ library   hs-source-dirs:     src+  other-extensions: DeriveDataTypeable Safe   ghc-options: -Wall -fwarn-tabs   build-depends:-    base        >=4.5      && <4.9,+    base        >=4.5      && <4.10,+    containers  >=0.5.3    && <0.6,     semigroups  >=0.16.2.2 && <0.19,     deepseq     >=1.3.0.0  && <1.5,     hashable    >=1.2.3.3  && <1.3   exposed-modules:+    Data.RangeSet.Internal+    Data.RangeSet.IntMap     Data.RangeSet.List+    Data.RangeSet.Map   default-language: Haskell2010  test-suite test@@ -45,7 +50,8 @@     tests   ghc-options: -Wall -fwarn-tabs   build-depends:-    base        >=4.5      && <4.9,+    base        >=4.5      && <4.10,+    containers  >=0.5.3    && <0.6,     semigroups  >=0.16.2.2 && <0.19,     deepseq     >=1.3.0.0  && <1.5,     hashable    >=1.2.3.3  && <1.3,@@ -53,4 +59,9 @@     tasty             >=0.8 && <0.12,     tasty-quickcheck  >=0.8 && <0.9,     range-set-list+  other-modules:+    IntMap+    List+    Map+    SetAction   default-language: Haskell2010

@@ -0,0 +1,338 @@+{- |+Module      :  Data.RangeSet.IntMap+Description :  Specialization of Data.RangeSet.Map to Ints+Copyright   :  (c) Dylan Simon, 2015+License     :  MIT++This is simply a specialization of "Data.RangeSet.Map" to 'Int'.++The implementation of 'RIntSet' is based on "Data.IntMap.Strict".+-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe               #-}+module Data.RangeSet.IntMap (+  -- * Range set type+  RIntSet++  -- * Operators+  , (\\)++  -- * Query+  , null+  , isFull+  , size+  , member+  , notMember+  , lookupLT+  , lookupGT+  , lookupLE+  , lookupGE+  , containsRange+  , isSubsetOf+  , valid++  -- * Construction+  , empty+  , full+  , singleton+  , singletonRange+  , insert+  , insertRange+  , delete+  , deleteRange++  -- * Combine+  , union+  , difference+  , intersection++  -- * Filter+  , split+  , splitMember++  -- * Min/Max+  , findMin+  , findMax++  -- * Complement+  , complement++  -- * Conversion+  , elems+  , toList+  , fromList+  , fromAscList+  , toAscList+  , toRangeList+  , fromRangeList+  , fromRList+  , toRList+  , fromNormalizedRangeList++  ) where++import Prelude hiding (filter, foldl, foldr, map, null)++import           Control.DeepSeq    (NFData (..))+import qualified Data.Foldable      as Fold+import           Data.Functor       ((<$>))+import qualified Data.IntMap.Strict as Map+import           Data.Monoid        (Monoid (..), getSum)+import           Data.Semigroup     (Semigroup (..))+import           Data.Typeable      (Typeable)++import           Data.RangeSet.Internal+import qualified Data.RangeSet.List     as RList++-- | Internally set is represented as sorted list of distinct inclusive ranges.+newtype RIntSet = RSet (Map.IntMap Int)+  deriving (Eq, Ord, Typeable)++instance Show RIntSet where+  show x = "fromRangeList " ++ show (toRangeList x)++instance Semigroup RIntSet where+  (<>) = union++instance Monoid RIntSet where+  mempty  = empty+  mappend = union++instance NFData RIntSet where+  rnf (RSet xs) = rnf xs++{- Operators -}+infixl 9 \\ --++-- | /O(n+m)/. See 'difference'.+(\\) :: RIntSet -> RIntSet -> RIntSet+m1 \\ m2 = difference m1 m2++{- Query -}++-- | /O(1)/. Is this the empty set?+null :: RIntSet -> Bool+null (RSet m) = Map.null m++-- | /O(1)/. Is this the empty set?+isFull :: RIntSet -> Bool+isFull = (==) full++-- | /O(n)/. The number of the elements in the set.+size :: RIntSet -> Int+size (RSet xm) = getSum $ Map.foldMapWithKey rangeSize xm++contains' :: Int -> Int -> RIntSet -> Bool+contains' x y (RSet xm) = Fold.any ((y <=) . snd) $ Map.lookupLE x xm++-- | /O(log n)/. Is the element in the set?+member :: Int -> RIntSet -> Bool+member x = contains' x x++-- | /O(log n)/. Is the element not in the set?+notMember :: Int -> RIntSet -> Bool+notMember a r = not $ member a r++-- | /O(log n)/. Find largest element smaller than the given one.+lookupLT :: Int -> RIntSet -> Maybe Int+lookupLT x (RSet xm) = min (pred x) . snd <$> Map.lookupLT x xm++-- | /O(log n)/. Find smallest element greater than the given one.+lookupGT :: Int -> RIntSet -> Maybe Int+lookupGT x (RSet xm)+  | Just (_, b) <- Map.lookupLE x xm, x < b = Just (succ x)+  | otherwise = fst <$> Map.lookupGT x xm++-- | /O(log n)/. Find largest element smaller or equal to than the given one.+lookupLE :: Int -> RIntSet -> Maybe Int+lookupLE x (RSet xm) = min x . snd <$> Map.lookupLE x xm++-- | /O(log n)/. Find smallest element greater or equal to than the given one.+lookupGE :: Int -> RIntSet -> Maybe Int+lookupGE x (RSet xm)+  | Just (_, b) <- Map.lookupLE x xm, x <= b = Just x+  | otherwise = fst <$> Map.lookupGT x xm++-- | /O(log n)/. Is the entire range contained within the set?+containsRange :: (Int, Int) -> RIntSet -> Bool+containsRange (x,y) s+  | x <= y = contains' x y s+  | otherwise = True++-- | /O(n+m)/. Is this a subset?+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.+isSubsetOf :: RIntSet -> RIntSet -> Bool+isSubsetOf x y = isSubsetRangeList (toRangeList x) (toRangeList y)++{- Construction -}++-- | /O(1)/. The empty set.+empty :: RIntSet+empty = RSet Map.empty++-- | /O(1)/. The full set.+full :: RIntSet+full = singletonRange' minBound maxBound++singletonRange' :: Int -> Int -> RIntSet+singletonRange' x y = RSet $ Map.singleton x y++-- | /O(1)/. Create a singleton set.+singleton :: Int -> RIntSet+singleton x = singletonRange' x x++-- | /O(1)/. Create a continuos range set.+singletonRange :: (Int, Int) -> RIntSet+singletonRange (x, y) | x > y     = empty+                      | otherwise = singletonRange' x y++{- Construction -}++insertRange' :: Int -> Int -> RIntSet -> RIntSet+insertRange' x y s = unRangeList $ insertRangeList x y $ toRangeList s++-- | /O(n)/. Insert an element in a set.+insert :: Int -> RIntSet -> RIntSet+insert x = insertRange' x x++-- | /O(n)/. Insert a continuos range in a set.+insertRange :: (Int, Int) -> RIntSet -> RIntSet+insertRange (x, y) set+  | x > y      = set+  | otherwise  = insertRange' x y set++deleteRange' :: Int -> Int -> RIntSet -> RIntSet+deleteRange' x y s = unRangeList $ deleteRangeList x y $ toRangeList s++-- | /O(n). Delete an element from a set.+delete :: Int -> RIntSet -> RIntSet+delete x = deleteRange' x x++-- | /O(n). Delete a continuos range from a set.+deleteRange :: (Int, Int) -> RIntSet -> RIntSet+deleteRange (x, y) set+  | x > y      = set+  | otherwise  = deleteRange' x y set++{- Combination -}++-- | /O(n*m)/. The union of two sets.+union :: RIntSet -> RIntSet -> RIntSet+union x y = unRangeList $ unionRangeList (toRangeList x) (toRangeList y)++-- | /O(n*m)/. Difference of two sets.+difference :: RIntSet -> RIntSet -> RIntSet+difference x y = unRangeList $ differenceRangeList (toRangeList x) (toRangeList y)++-- | /O(n*m)/. The intersection of two sets.+intersection :: RIntSet -> RIntSet -> RIntSet+intersection x y = unRangeList $ intersectRangeList (toRangeList x) (toRangeList y)++{- Complement -}++-- | /O(n)/. Complement of the set.+complement :: RIntSet -> RIntSet+complement = unRangeList . complementRangeList . toRangeList++{- Filter -}++-- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@.+split :: Int -> RIntSet -> (RIntSet, RIntSet)+split x s = (l, r) where (l, _, r) = splitMember x s++-- | /O(log n)/. Performs a 'split' but also returns whether the pivot+-- element was found in the original set.+splitMember :: Int -> RIntSet -> (RIntSet, Bool, RIntSet)+splitMember x (RSet xm)+  | Just y <- xv = (RSet ml, True, RSet $ insertIf (x < y) (succ x) y mr)+  | Just ((u,v), ml') <- Map.maxViewWithKey ml =+    if v < x+      then (RSet ml, False, RSet mr)+      else (RSet $ insertIf (u < x) u (pred x) ml', True, RSet $ insertIf (x < v) (succ x) v mr)+  | otherwise = (RSet ml {- empty -}, False, RSet {- mr -} xm)+  where+  (ml, xv, mr) = Map.splitLookup x xm+  insertIf False _ _ = id+  insertIf True a b = Map.insert a b++{- Min/Max -}++-- | /O(log n)/. The minimal element of a set.+findMin :: RIntSet -> Int+findMin (RSet m) = fst $ Map.findMin m++-- | /O(log n)/. The maximal element of a set.+findMax :: RIntSet -> Int+findMax (RSet m) = snd $ Map.findMax m++{- Conversion -}++unRangeList :: [(Int, Int)] -> RIntSet+unRangeList = RSet . Map.fromDistinctAscList++-- | /O(n*r)/. An alias of 'toAscList'. The elements of a set in ascending+-- order. /r/ is the size of longest range.+elems :: RIntSet -> [Int]+elems = toAscList++-- | /O(n*r)/. Convert the set to a list of elements (in arbitrary order). /r/+-- is the size of longest range.+toList :: RIntSet -> [Int]+toList (RSet xm) = Map.foldMapWithKey enumFromTo xm++-- | /O(n*log n)/. Create a set from a list of elements.+--+-- Note that unlike "Data.Set" and other binary trees, this always requires a+-- full sort and traversal to create distinct, disjoint ranges before+-- constructing the tree.+fromList :: [Int] -> RIntSet+fromList = unRangeList . fromElemList++-- | /O(n)/. Create a set from a list of ascending elements.+--+-- /The precondition is not checked./  You may use 'valid' to check the result.+-- Note that unlike "Data.Set" and other binary trees, this always requires a+-- full traversal to create distinct, disjoint ranges before constructing the+-- tree.+fromAscList :: [Int] -> RIntSet+fromAscList = unRangeList . fromAscElemList++-- | /O(n*r)/. Convert the set to an ascending list of elements.+toAscList :: RIntSet -> [Int]+toAscList (RSet xm) = Map.foldrWithKey (\a -> (++) . enumFromTo a) [] xm++-- | /O(n)/. Convert the set to a list of range pairs.+toRangeList :: RIntSet -> [(Int, Int)]+toRangeList (RSet xs) = Map.toAscList xs++-- | /O(n*log n)/. Create a set from a list of range pairs.+--+-- Note that unlike "Data.Set" and other binary trees, this always requires a+-- full sort and traversal to create distinct, disjoint ranges before+-- constructing the tree.+fromRangeList :: [(Int, Int)] -> RIntSet+fromRangeList = unRangeList . normalizeRangeList++-- | /O(n)/. Convert a list-based 'RList.RSet' to a map-based 'RIntSet'.+fromRList :: RList.RSet Int -> RIntSet+fromRList = fromNormalizedRangeList . RList.toRangeList++-- | /O(n)/. Convert a map-based 'RIntSet' to a list-based 'RList.RSet'.+toRList :: RIntSet -> RList.RSet Int+toRList = RList.fromNormalizedRangeList . toRangeList++-- | /O(n)/. Convert a normalized, non-adjacent, ascending list of ranges to a set.+--+-- /The precondition is not checked./  In general you should only use this+-- function on the result of 'toRangeList' or ensure 'valid' on the result.+fromNormalizedRangeList :: [(Int, Int)] -> RIntSet+fromNormalizedRangeList = RSet . Map.fromDistinctAscList++-- | /O(n)/. Ensure that a set is valid. All functions should return valid sets+-- except those with unchecked preconditions: 'fromAscList',+-- 'fromNormalizedRangeList'+valid :: RIntSet -> Bool+valid = validRangeList . toRangeList+

@@ -0,0 +1,202 @@+{- |+Module      :  Data.RangeSet.Internal+Description :  Support functions for dealing with distinct ordered range lists+Copyright   :  (c) Dylan Simon 2015+License     :  MIT++Maintainer  :  oleg.grenrus@iki.fi+Stability   :  experimental+Portability :  non-portable (tested with GHC only)++Most functions in this module deal with normalized (closed, fst <= snd,+non-overlapping, non-adjacent, ordered) ranges, but do not check this+assumption.  Most users should use a higher-level interface.+-}+{-# LANGUAGE Safe               #-}+module Data.RangeSet.Internal+  ( rangeSize+  , rangeIsSubsetList+  , isSubsetRangeList+  , insertRangeList+  , deleteRangeList+  , unionRangeList+  , differenceRangeList+  , intersectRangeList+  , complementRangeList+  , fromAscElemList+  , fromElemList+  , normalizeRangeList+  , validRangeList+  ) where++import Data.List   (sort)+import Data.Monoid (Sum (..))++-- | Determine the number of items in an 'Enum' range as a 'Sum'+rangeSize :: Enum a => a -> a -> Sum Int+rangeSize a b = Sum $ succ $ fromEnum b - fromEnum a++-- | Determine if @[x,y]@ is a subset of the list, returning the list right of+-- @y@ if so.+rangeIsSubsetList :: Ord a => a -> a -> [(a, a)] -> Maybe [(a, a)]+rangeIsSubsetList x y ((u,v):s)+  | x < u = Nothing+  | y <= v = Just ((y,v):s)+  | otherwise = rangeIsSubsetList x y s+rangeIsSubsetList _ _ [] = Nothing++-- | Determine if the first list is a subset of the second.+isSubsetRangeList :: Ord a => [(a, a)] -> [(a, a)] -> Bool+isSubsetRangeList ((x,y):as) bs = maybe False (isSubsetRangeList as) $ rangeIsSubsetList x y bs+isSubsetRangeList [] _ = True++-- | Add @[x,y]@.+--+-- There are three possibilities we consider, when inserting into non-empty set:+--+-- * discretely after: continue+-- * discretely before: prepend+-- * overlapping: union and prepend+insertRangeList :: (Ord a, Enum a) => a -> a -> [(a, a)] -> [(a, a)]+insertRangeList x y set@(uv@(u,v) : xs)+  | v < x && succ v /= x = uv : insertRangeList x y xs+  | y < u && succ y /= u = (x,y) : set+  | otherwise            = prependRangeList (min x u) (max y v) xs+insertRangeList x y [] = [(x,y)]++-- | Add @[x,y]@ to the beginning (assuming @x <= u@).+prependRangeList :: (Ord a, Enum a) => a -> a -> [(a, a)] -> [(a, a)]+prependRangeList x y set@((u,v) : xs)+  | y < u && succ y /= u = (x,y) : set+  | otherwise            = prependRangeList x (max y v) xs+prependRangeList x y [] = [(x,y)]++-- | Union two range lists.+unionRangeList :: (Ord a, Enum a) => [(a, a)] -> [(a, a)] -> [(a, a)]+unionRangeList aset@(xy@(x,y):as) bset@(uv@(u,v):bs)+  | y < u && succ y /= u = xy : unionRangeList as bset+  | v < x && succ v /= x = uv : unionRangeList aset bs+  | otherwise = prependRangeList (min x u) (max y v) $ unionRangeList as bs+unionRangeList s [] = s+unionRangeList [] s = s++-- | Remove a range from a range list.+--+-- There are 6 possibilities we consider, when deleting from non-empty set:+--+-- * more+-- * less+-- * strictly inside (splits)+-- * overlapping less-edge+-- * overlapping more-edge+-- * stricly larger+deleteRangeList :: (Ord a, Enum a) => a -> a -> [(a, a)] -> [(a, a)]+deleteRangeList x y set@(s@(u,v) : xs)+  | v < x = s : deleteRangeList x y xs+  | y < u = set+  | u < x = (u, pred x) : t+  | otherwise = t where+  t = trimRangeList' y v xs+deleteRangeList _ _ [] = []++-- | Remove @(,y]@ while (re-)adding @(y,v]@ if valid+trimRangeList' :: (Ord a, Enum a) => a -> a -> [(a, a)] -> [(a, a)]+trimRangeList' y v xs+  | y < v = (succ y, v) : xs+  | otherwise = trimRangeList y xs++-- | Remove @(,y]@+trimRangeList :: (Ord a, Enum a) => a -> [(a, a)] -> [(a, a)]+trimRangeList y set@((u,v) : xs)+  | y < u = set+  | otherwise = trimRangeList' y v xs+trimRangeList _ [] = []++-- | Compute the set difference, removing each range in the second list from+-- the first.+differenceRangeList :: (Ord a, Enum a) => [(a, a)] -> [(a, a)] -> [(a, a)]+differenceRangeList aset@(xy@(x,y):as) bset@((u,v):bs)+  | y < u = xy : differenceRangeList as bset+  | v < x = differenceRangeList aset bs+  | x < u = (x, pred u) : t+  | otherwise = t where+  t = differenceRangeList (trimRangeList' v y as) bs+differenceRangeList s [] = s+differenceRangeList [] _ = []++-- | Compute the intersection.+intersectRangeList :: Ord a => [(a, a)] -> [(a, a)] -> [(a, a)]+intersectRangeList aset@((x,y):as) bset@((u,v):bs)+  | y < u = intersectRangeList as bset+  | v < x = intersectRangeList aset bs+  | y < v = (max x u, y) : intersectRangeList as bset+  | otherwise = (max x u, v) : intersectRangeList aset bs+intersectRangeList _ [] = []+intersectRangeList [] _ = []++-- | Compute the complement intersected with @[x,)@ assuming @x<u@.+complementRangeList' :: (Ord a, Enum a, Bounded a) => a -> [(a, a)] -> [(a, a)]+complementRangeList' x ((u,v):s) = (x,pred u) : complementRangeList'' v s+complementRangeList' x [] = [(x,maxBound)]++-- | Compute the complement intersected with @(x,)@.+complementRangeList'' :: (Ord a, Enum a, Bounded a) => a -> [(a, a)] -> [(a, a)]+complementRangeList'' x s+  | x == maxBound = []+  | otherwise = complementRangeList' (succ x) s++-- | Compute the complement.+complementRangeList :: (Ord a, Enum a, Bounded a) => [(a, a)] -> [(a, a)]+complementRangeList s@((x,y):s')+  | x == minBound = complementRangeList'' y s'+  | otherwise = complementRangeList' minBound s+complementRangeList [] = [(minBound, maxBound)]++-- | Take elements off the beginning of the list while they are equal or+-- adjacent to the given item, and return the last removed item and remaining+-- list.+takeWhileAdj :: (Eq a, Enum a) => a -> [a] -> (a, [a])+takeWhileAdj x yl@(y:l)+  | x == y || succ x == y = takeWhileAdj y l+  | otherwise = (x, yl)+takeWhileAdj x [] = (x, [])++-- | Take ranges off the beginning of a unnormalized but sorted and valid range+-- list while they are overlapping or adjacent to the given value, and return+-- the last removed item and remaining list.+takeWhileRangeAdj :: (Ord a, Enum a) => a -> [(a,a)] -> (a, [(a,a)])+takeWhileRangeAdj x yzl@((y,z):l)+  | x >= y || succ x == y = takeWhileRangeAdj (max x z) l+  | otherwise = (x, yzl)+takeWhileRangeAdj x [] = (x, [])++-- | Normalize a sorted list of elements to a range list.+fromAscElemList :: (Eq a, Enum a) => [a] -> [(a, a)]+fromAscElemList (x:l) = (x, y) : fromAscElemList l' where+  (y, l') = takeWhileAdj x l+fromAscElemList [] = []++-- | Normalize an arbitrary list of elements to a range list.+fromElemList :: (Ord a, Enum a) => [a] -> [(a, a)]+fromElemList = fromAscElemList . sort++-- | Normalize a sorted list of valid ranges.+mergeRangeList :: (Ord a, Enum a) => [(a, a)] -> [(a, a)]+mergeRangeList ((x,y):l) = (x,y') : mergeRangeList l' where+  (y', l') = takeWhileRangeAdj y l+mergeRangeList [] = []++-- | Normalize an arbitrary list of ranges.+normalizeRangeList :: (Ord a, Enum a) => [(a, a)] -> [(a, a)]+normalizeRangeList = mergeRangeList . sort . filter valid where+  valid (x,y) = x <= y++-- | Check if a list is normalized and strictly above @b@.+validRangeList' :: (Ord a, Enum a, Bounded a) => a -> [(a, a)] -> Bool+validRangeList' b ((x,y):s) = b < maxBound && succ b < x && x <= y && validRangeList' y s+validRangeList' _ [] = True++-- | Check if a list is normalized.+validRangeList :: (Ord a, Enum a, Bounded a) => [(a, a)] -> Bool+validRangeList ((x,y):s) = x <= y && validRangeList' y s+validRangeList [] = True

@@ -18,18 +18,20 @@  The implementation of 'RSet' is based on /list/. -Compared to 'Data.Set', this module imposes also 'Enum' restriction for many functions.-We must be able to identify consecutive elements to be able to /glue/ and /split/ ranges properly.+Compared to 'Data.Set', this module imposes also 'Enum' restriction for many+functions.  We must be able to identify consecutive elements to be able to+/glue/ and /split/ ranges properly.  The implementation assumes that  > x < succ x > pred x < x -and there aren't elements in between (not true for 'Float' and 'Double').-Also 'succ' and 'pred' are never called for largest or smallest value respectively.+and there aren't elements in between (not true for 'Float' and 'Double').  Also+'succ' and 'pred' are never called for largest or smallest value respectively. -} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe               #-} module Data.RangeSet.List (   -- * Range set type   RSet@@ -39,9 +41,17 @@    -- * Query   , null+  , isFull   , size   , member   , notMember+  , lookupLT+  , lookupGT+  , lookupLE+  , lookupGE+  , containsRange+  , isSubsetOf+  , valid    -- * Construction   , empty@@ -58,6 +68,10 @@   , difference   , intersection +  -- * Filter+  , split+  , splitMember+   -- * Min/Max   , findMin   , findMax@@ -69,20 +83,29 @@   , elems   , toList   , fromList+  , fromAscList+  , toAscList   , toRangeList   , fromRangeList+  , fromNormalizedRangeList+  , toSet    ) where -import Prelude hiding (filter,foldl,foldr,null,map)+import           Prelude hiding (filter, foldl, foldr, map, null) import qualified Prelude -import Control.DeepSeq (NFData(..))-import Data.Typeable (Typeable)-import Data.Semigroup (Semigroup(..))-import Data.Monoid (Monoid(..))-import Data.Hashable (Hashable(..))+import           Control.DeepSeq (NFData (..))+import           Data.Foldable   (foldMap)+import           Data.Hashable   (Hashable (..))+import           Data.Maybe      (isJust)+import           Data.Monoid     (Monoid (..), getSum)+import           Data.Semigroup  (Semigroup (..))+import qualified Data.Set        as Set+import           Data.Typeable   (Typeable) +import Data.RangeSet.Internal+ -- | Internally set is represented as sorted list of distinct inclusive ranges. newtype RSet a = RSet [(a, a)]   deriving (Eq, Ord, Typeable)@@ -116,21 +139,76 @@ null :: RSet a -> Bool null = Prelude.null . toRangeList +-- | /O(1)/. Is this the full set?+isFull :: (Eq a, Bounded a) => RSet a -> Bool+isFull = (==) full+ -- | /O(n)/. The number of the elements in the set. size :: Enum a => RSet a -> Int-size (RSet xs) = sum (Prelude.map f xs)-  where f (a, b) = fromEnum b - fromEnum a + 1+size (RSet xs) = getSum $ foldMap (uncurry rangeSize) xs  -- | /O(n)/. Is the element in the set?-member :: (Ord a, Enum a) => a -> RSet a -> Bool-member x (RSet xs) = any f $ takeWhile g xs-  where f (a, b) = a <= x && x <= b-        g (a,_) = a <= x+member :: Ord a => a -> RSet a -> Bool+member x (RSet xs) = f xs where+  f ((a,b):s)+    | x < a = False+    | x <= b = True+    | otherwise = f s+  f [] = False  -- | /O(n)/. Is the element not in the set?-notMember :: (Ord a, Enum a) => a -> RSet a -> Bool+notMember :: Ord a => a -> RSet a -> Bool notMember a r = not $ member a r +-- | /O(n)/. Find largest element smaller than the given one.+lookupLT :: (Ord a, Enum a) => a -> RSet a -> Maybe a+lookupLT x (RSet xs) = f Nothing xs where+  f l ((a,b):s)+    | x <= a = l+    | x <= b || pred x == b = Just (pred x)+    | otherwise = f (Just b) s+  f l [] = l++-- | /O(n)/. Find smallest element greater than the given one.+lookupGT :: (Ord a, Enum a) => a -> RSet a -> Maybe a+lookupGT x (RSet xs) = f xs where+  f ((a,b):s)+    | x < a = Just a+    | x < b = Just (succ x)+    | otherwise = f s+  f [] = Nothing++-- | /O(n)/. Find largest element smaller or equal to than the given one.+lookupLE :: Ord a => a -> RSet a -> Maybe a+lookupLE x (RSet xs) = f Nothing xs where+  f l ((a,b):s)+    | x < a = l+    | x <= b = Just x+    | otherwise = f (Just b) s+  f l [] = l++-- | /O(n)/. Find smallest element greater or equal to than the given one.+lookupGE :: Ord a => a -> RSet a -> Maybe a+lookupGE x (RSet xs) = f xs where+  f ((a,b):s)+    | x <= a = Just a+    | x <= b = Just x+    | otherwise = f s+  f [] = Nothing++-- | /O(n)/. Is the entire range contained within the set?+containsRange :: Ord a => (a, a) -> RSet a -> Bool+containsRange (x,y) (RSet xs)+  | x <= y = isJust $ rangeIsSubsetList x y xs+  | otherwise = True++-- | /O(n+m)/. Is this a subset?+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.+isSubsetOf :: Ord a => RSet a -> RSet a -> Bool+isSubsetOf (RSet xs) (RSet ys) = isSubsetRangeList xs ys++-- MISSING: isProperSubsetOf isRangeProperSubsetOf? overlapsRange?+ {- Construction -}  -- | /O(1)/. The empty set.@@ -139,89 +217,92 @@  -- | /O(1)/. The full set. full :: Bounded a => RSet a-full = RSet [(minBound, maxBound)]+full = singletonRange' minBound maxBound +singletonRange' :: a -> a -> RSet a+singletonRange' x y = RSet [(x, y)]+ -- | /O(1)/. Create a singleton set. singleton :: a -> RSet a-singleton x = RSet [(x, x)]+singleton x = singletonRange' x x  -- | /O(1)/. Create a continuos range set. singletonRange :: Ord a => (a, a) -> RSet a singletonRange (x, y) | x > y     = empty-                      | otherwise = RSet [(x, y)]+                      | otherwise = singletonRange' x y  {- Construction -}  -- | /O(n)/. Insert an element in a set. insert :: (Ord a, Enum a) => a -> RSet a -> RSet a-insert x = insertRange (x, x)+insert x (RSet xs) = RSet $ insertRangeList x x xs  -- | /O(n)/. Insert a continuos range in a set. insertRange :: (Ord a, Enum a) => (a, a) -> RSet a -> RSet a-insertRange r@(x, y) set@(RSet xs)+insertRange (x, y) set@(RSet xs)   | x > y      = set-  | otherwise  = RSet $ insertRange' r xs---- There are three possibilities we consider, when inserting into non-empty set:--- * discretely less--- * discretely more--- * other-insertRange' :: (Ord a, Enum a) => (a, a) -> [(a, a)] -> [(a, a)]-insertRange' r        []  = [r]-insertRange' r@(x, y) set@(s@(u, v) : xs)-  | y < u && succ y /= u  = r : set-  | v < x && succ v /= x  = s : insertRange' r xs-  | otherwise             = insertRange' (min x u, max y v) xs+  | otherwise  = RSet $ insertRangeList x y xs  -- | /O(n). Delete an element from a set. delete :: (Ord a, Enum a) => a -> RSet a -> RSet a-delete x = deleteRange (x, x)+delete x (RSet xs) = RSet $ deleteRangeList x x xs  -- | /O(n). Delete a continuos range from a set. deleteRange :: (Ord a, Enum a) => (a, a) -> RSet a -> RSet a-deleteRange r@(x, y) set@(RSet xs)+deleteRange (x, y) set@(RSet xs)   | x > y      = set-  | otherwise  = RSet $ deleteRange' r xs---- There are 6 possibilities we consider, when deleting from non-empty set:--- * less--- * more--- * strictly inside (splits)--- * overlapping less-edge--- * overlapping more-edge--- * stricly larger------ TODO: is there simpler rules, with less cases-deleteRange' :: (Ord a, Enum a) => (a, a) -> [(a, a)] -> [(a, a)]-deleteRange' _        []  = []-deleteRange' r@(x, y) set@(s@(u, v) : xs)-  | y < u                 = set-  | v < x                 = s : deleteRange' r xs-  | u < x && y < v        = (u, pred x) : (succ y, v) : xs-  | y < v                 = (succ y, v) : xs-  | u < x                 = (u, pred x) : deleteRange' r xs-  | otherwise             = deleteRange' r xs+  | otherwise  = RSet $ deleteRangeList x y xs  {- Combination -} --- | /O(n*m)/. The union of two sets.+-- | /O(n+m)/. The union of two sets. union :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a-union set (RSet xs) = Prelude.foldr insertRange set xs+union (RSet xs) (RSet ys) = RSet $ unionRangeList xs ys --- | /O(n*m)/. Difference of two sets.+-- | /O(n+m)/. Difference of two sets. difference :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a-difference set (RSet xs) = Prelude.foldr deleteRange set xs+difference (RSet xs) (RSet ys) = RSet $ differenceRangeList xs ys --- | /O(n*m)/. The intersection of two sets.-intersection :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a-intersection a b = a \\ (a \\ b)+-- | /O(n+m)/. The intersection of two sets.+intersection :: (Ord a) => RSet a -> RSet a -> RSet a+intersection (RSet xs) (RSet ys) = RSet $ intersectRangeList xs ys  {- Complement -}  -- | /O(n)/. Complement of the set. complement :: (Ord a, Enum a, Bounded a) => RSet a -> RSet a-complement a = full `difference` a+complement (RSet xs) = RSet $ complementRangeList xs +{- Filter -}++-- MISSING: filter partition filterRanges? partitionRanges?++-- | /O(n)/. The expression (@'split' x set@) is a pair @(set1,set2)@+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@.+split :: (Ord a, Enum a) => a -> RSet a -> (RSet a, RSet a)+split x s = (l, r) where (l, _, r) = splitMember x s++-- | /O(n)/. Performs a 'split' but also returns whether the pivot+-- element was found in the original set.+splitMember :: (Ord a, Enum a) => a -> RSet a -> (RSet a, Bool, RSet a)+splitMember x (RSet xs) = f xs where+  f s@(r@(a,b):s') = case compare x a of+    LT -> (empty, False, RSet s)+    EQ -> (empty, True, RSet xs')+    GT+      | x <= b -> (RSet [(a, pred x)], True, RSet xs')+      | otherwise -> push r $ f s'+    where+    xs'+      | x < b = (succ x,b):s'+      | otherwise = s'+  f [] = (empty, False, empty)+  push r (RSet ls, b, RSet rs) = (RSet (r:ls), b, RSet rs)++-- MISSING: lookupIndex findIndex elemAt deleteAt map mapMonotonic fold*+-- mapMonotonic may be reasonable as just need to map range endpoints and check adjacency+ {- Min/Max -}  -- | /O(1)/. The minimal element of a set.@@ -236,25 +317,59 @@         findMax' (_:xs)    = findMax' xs         findMax' _         = error "RangeSet.List.findMax: empty set" +-- MISSING: deleteMin deleteMax deleteFindMin deleteFindMax minView maxView+ {- Conversion -} --- | /O(n*r)/. Convert the set to a list of elements. /r/ is the size of longest range.+-- | /O(n*r)/. An alias of 'toAscList'. The elements of a set in ascending+-- order. /r/ is the size of longest range. elems :: Enum a => RSet a -> [a]-elems = toList+elems = toAscList --- | /O(n*r)/. Convert the set to a list of elements. /r/ is the size of longest range.+-- | /O(n*r)/. Convert the set to a list of elements. /r/ is the size of+-- longest range. toList :: Enum a => RSet a -> [a] toList (RSet xs) = concatMap (uncurry enumFromTo) xs --- | /O(n^2)/. Create a set from a list of elements.+-- | /O(n*log n)/. Create a set from a list of elements. fromList :: (Ord a, Enum a) => [a] -> RSet a-fromList = fromRangeList . Prelude.map f-  where f a = (a, a)+fromList = RSet . fromElemList +-- | /O(n)/. Create a set from a list of ascending elements.+--+-- /The precondition is not checked./  You may use 'valid' to check the result.+fromAscList :: (Ord a, Enum a) => [a] -> RSet a+fromAscList = RSet . fromAscElemList++-- | /O(n*r)/. Convert the set to an ascending list of elements.+toAscList :: Enum a => RSet a -> [a]+toAscList = toList+ -- | /O(1)/. Convert the set to a list of range pairs. toRangeList :: RSet a -> [(a, a)] toRangeList (RSet xs) = xs --- | /O(n^2)/. Create a set from a list of range pairs.+-- | /O(n*log n)/. Create a set from a list of range pairs. fromRangeList :: (Ord a, Enum a) => [(a, a)] -> RSet a-fromRangeList = Prelude.foldr insertRange empty+fromRangeList = RSet . normalizeRangeList++-- | /O(n*r)/. Convert the set to a 'Set.Set' of elements. /r/ is the size of+-- longest range.+toSet :: Enum a => RSet a -> Set.Set a+toSet = Set.fromDistinctAscList . toAscList++-- | /O(1)/. Convert a normalized, non-adjacent, ascending list of ranges to a+-- set.+--+-- /The precondition is not checked./  In general you should only use this+-- function on the result of 'toRangeList' or ensure 'valid' on the result.+fromNormalizedRangeList :: [(a, a)] -> RSet a+fromNormalizedRangeList = RSet++-- | /O(n)/. Ensure that a set is valid. All functions should return valid sets+-- except those with unchecked preconditions: 'fromAscList',+-- 'fromNormalizedRangeList'+valid :: (Ord a, Enum a, Bounded a) => RSet a -> Bool+valid (RSet xs) = validRangeList xs++-- MISSING: fromDistinctAscList fromAscRangeList

@@ -0,0 +1,342 @@+{- |+Module      :  Data.RangeSet.Map+Description :  A slightly less trivial implementation of range sets+Copyright   :  (c) Dylan Simon, 2015+License     :  MIT++A slightly less trivial implementation of range sets.++This is nearly identical to "Data.RangeSet.List" except for some important+performance differences:++* Most query functions in this module are /O(log n)/ rather than /O(n)/, so may+  be much faster.+* Most composition functions have the same time complexity but a higher+  constant, so may be somewhat slower.++If you're mainly calling 'member', you should consider using this module, but+if you're calling 'union', 'deleteRange', and other range manipulation+functions as often as querying, you might stick with the list implementation.++This module is intended to be imported qualified, to avoid name+clashes with Prelude functions, e.g.++>  import Data.RangeSet.Map (RSet)+>  import qualified Data.RangeSet.Map as RSet++The implementation of 'RSet' is based on "Data.Map.Strict".++-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe               #-}+module Data.RangeSet.Map (+  -- * Range set type+  RSet++  -- * Operators+  , (\\)++  -- * Query+  , null+  , isFull+  , size+  , member+  , notMember+  , lookupLT+  , lookupGT+  , lookupLE+  , lookupGE+  , containsRange+  , isSubsetOf+  , valid++  -- * Construction+  , empty+  , full+  , singleton+  , singletonRange+  , insert+  , insertRange+  , delete+  , deleteRange++  -- * Combine+  , union+  , difference+  , intersection++  -- * Filter+  , split+  , splitMember++  -- * Min/Max+  , findMin+  , findMax++  -- * Complement+  , complement++  -- * Conversion+  , elems+  , toList+  , fromList+  , fromAscList+  , toAscList+  , toRangeList+  , fromRangeList+  , fromRList+  , toRList+  , fromNormalizedRangeList++  ) where++import Prelude hiding (filter, foldl, foldr, map, null)++import           Control.DeepSeq (NFData (..))+import qualified Data.Foldable   as Fold+import           Data.Functor    ((<$>))+import qualified Data.Map.Strict as Map+import           Data.Monoid     (Monoid (..), getSum)+import           Data.Semigroup  (Semigroup (..))+import           Data.Typeable   (Typeable)++import           Data.RangeSet.Internal+import qualified Data.RangeSet.List     as RList++-- | Internally set is represented as sorted list of distinct inclusive ranges.+newtype RSet a = RSet (Map.Map a a)+  deriving (Eq, Ord, Typeable)++instance Show a => Show (RSet a) where+  show x = "fromRangeList " ++ show (toRangeList x)++instance (Ord a, Enum a) => Semigroup (RSet a) where+  (<>) = union++instance (Ord a, Enum a) => Monoid (RSet a) where+  mempty  = empty+  mappend = union++instance NFData a => NFData (RSet a) where+  rnf (RSet xs) = rnf xs++{- Operators -}+infixl 9 \\ --++-- | /O(n+m)/. See 'difference'.+(\\) :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a+m1 \\ m2 = difference m1 m2++{- Query -}++-- | /O(1)/. Is this the empty set?+null :: RSet a -> Bool+null (RSet m) = Map.null m++-- | /O(1)/. Is this the empty set?+isFull :: (Eq a, Bounded a) => RSet a -> Bool+isFull = (==) full++-- | /O(n)/. The number of the elements in the set.+size :: Enum a => RSet a -> Int+size (RSet xm) = getSum $ Map.foldMapWithKey rangeSize xm++contains' :: Ord a => a -> a -> RSet a -> Bool+contains' x y (RSet xm) = Fold.any ((y <=) . snd) $ Map.lookupLE x xm++-- | /O(log n)/. Is the element in the set?+member :: (Ord a, Enum a) => a -> RSet a -> Bool+member x = contains' x x++-- | /O(log n)/. Is the element not in the set?+notMember :: (Ord a, Enum a) => a -> RSet a -> Bool+notMember a r = not $ member a r++-- | /O(log n)/. Find largest element smaller than the given one.+lookupLT :: (Ord a, Enum a) => a -> RSet a -> Maybe a+lookupLT x (RSet xm) = min (pred x) . snd <$> Map.lookupLT x xm++-- | /O(log n)/. Find smallest element greater than the given one.+lookupGT :: (Ord a, Enum a) => a -> RSet a -> Maybe a+lookupGT x (RSet xm)+  | Just (_, b) <- Map.lookupLE x xm, x < b = Just (succ x)+  | otherwise = fst <$> Map.lookupGT x xm++-- | /O(log n)/. Find largest element smaller or equal to than the given one.+lookupLE :: Ord a => a -> RSet a -> Maybe a+lookupLE x (RSet xm) = min x . snd <$> Map.lookupLE x xm++-- | /O(log n)/. Find smallest element greater or equal to than the given one.+lookupGE :: Ord a => a -> RSet a -> Maybe a+lookupGE x (RSet xm)+  | Just (_, b) <- Map.lookupLE x xm, x <= b = Just x+  | otherwise = fst <$> Map.lookupGT x xm++-- | /O(log n)/. Is the entire range contained within the set?+containsRange :: Ord a => (a, a) -> RSet a -> Bool+containsRange (x,y) s+  | x <= y = contains' x y s+  | otherwise = True++-- | /O(n+m)/. Is this a subset?+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.+isSubsetOf :: Ord a => RSet a -> RSet a -> Bool+isSubsetOf x y = isSubsetRangeList (toRangeList x) (toRangeList y)++{- Construction -}++-- | /O(1)/. The empty set.+empty :: RSet a+empty = RSet Map.empty++-- | /O(1)/. The full set.+full :: Bounded a => RSet a+full = singletonRange' minBound maxBound++singletonRange' :: a -> a -> RSet a+singletonRange' x y = RSet $ Map.singleton x y++-- | /O(1)/. Create a singleton set.+singleton :: a -> RSet a+singleton x = singletonRange' x x++-- | /O(1)/. Create a continuos range set.+singletonRange :: Ord a => (a, a) -> RSet a+singletonRange (x, y) | x > y     = empty+                      | otherwise = singletonRange' x y++{- Construction -}++insertRange' :: (Ord a, Enum a) => a -> a -> RSet a -> RSet a+insertRange' x y s = unRangeList $ insertRangeList x y $ toRangeList s++-- | /O(n)/. Insert an element in a set.+insert :: (Ord a, Enum a) => a -> RSet a -> RSet a+insert x = insertRange' x x++-- | /O(n)/. Insert a continuos range in a set.+insertRange :: (Ord a, Enum a) => (a, a) -> RSet a -> RSet a+insertRange (x, y) set+  | x > y      = set+  | otherwise  = insertRange' x y set++deleteRange' :: (Ord a, Enum a) => a -> a -> RSet a -> RSet a+deleteRange' x y = unRangeList . deleteRangeList x y . toRangeList++-- | /O(n). Delete an element from a set.+delete :: (Ord a, Enum a) => a -> RSet a -> RSet a+delete x = deleteRange' x x++-- | /O(n). Delete a continuos range from a set.+deleteRange :: (Ord a, Enum a) => (a, a) -> RSet a -> RSet a+deleteRange (x, y) set+  | x > y      = set+  | otherwise  = deleteRange' x y set++{- Combination -}++-- | /O(n*m)/. The union of two sets.+union :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a+union x y = unRangeList $ unionRangeList (toRangeList x) (toRangeList y)++-- | /O(n*m)/. Difference of two sets.+difference :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a+difference x y = unRangeList $ differenceRangeList (toRangeList x) (toRangeList y)++-- | /O(n*m)/. The intersection of two sets.+intersection :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a+intersection x y = unRangeList $ intersectRangeList (toRangeList x) (toRangeList y)++{- Complement -}++-- | /O(n)/. Complement of the set.+complement :: (Ord a, Enum a, Bounded a) => RSet a -> RSet a+complement = unRangeList . complementRangeList . toRangeList++{- Filter -}++-- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@.+split :: (Ord a, Enum a) => a -> RSet a -> (RSet a, RSet a)+split x s = (l, r) where (l, _, r) = splitMember x s++-- | /O(log n)/. Performs a 'split' but also returns whether the pivot+-- element was found in the original set.+splitMember :: (Ord a, Enum a) => a -> RSet a -> (RSet a, Bool, RSet a)+splitMember x (RSet xm)+  | Just y <- xv = (RSet ml, True, RSet $ insertIf (x < y) (succ x) y mr)+  | Just ((u,v), ml') <- Map.maxViewWithKey ml =+    if v < x+      then (RSet ml, False, RSet mr)+      else (RSet $ insertIf (u < x) u (pred x) ml', True, RSet $ insertIf (x < v) (succ x) v mr)+  | otherwise = (RSet ml {- empty -}, False, RSet {- mr -} xm)+  where+  (ml, xv, mr) = Map.splitLookup x xm+  insertIf False _ _ = id+  insertIf True a b = Map.insert a b++{- Min/Max -}++-- | /O(log n)/. The minimal element of a set.+findMin :: RSet a -> a+findMin (RSet m) = fst $ Map.findMin m++-- | /O(log n)/. The maximal element of a set.+findMax :: RSet a -> a+findMax (RSet m) = snd $ Map.findMax m++{- Conversion -}++unRangeList :: [(a, a)] -> RSet a+unRangeList = RSet . Map.fromDistinctAscList++-- | /O(n*r)/. An alias of 'toAscList'. The elements of a set in ascending order. /r/ is the size of longest range.+elems :: Enum a => RSet a -> [a]+elems = toAscList++-- | /O(n*r)/. Convert the set to a list of elements (in arbitrary order). /r/ is the size of longest range.+toList :: Enum a => RSet a -> [a]+toList (RSet xm) = Map.foldMapWithKey enumFromTo xm++-- | /O(n*log n)/. Create a set from a list of elements.+-- Note that unlike "Data.Set" and other binary trees, this always requires a full sort and traversal to create distinct, disjoint ranges before constructing the tree.+fromList :: (Ord a, Enum a) => [a] -> RSet a+fromList = unRangeList . fromElemList++-- | /O(n)/. Create a set from a list of ascending elements.+-- /The precondition is not checked./  You may use 'valid' to check the result.+-- Note that unlike "Data.Set" and other binary trees, this always requires a full traversal to create distinct, disjoint ranges before constructing the tree.+fromAscList :: (Ord a, Enum a) => [a] -> RSet a+fromAscList = unRangeList . fromAscElemList++-- | /O(n*r)/. Convert the set to an ascending list of elements.+toAscList :: Enum a => RSet a -> [a]+toAscList (RSet xm) = Map.foldrWithKey (\a -> (++) . enumFromTo a) [] xm++-- | /O(n)/. Convert the set to a list of range pairs.+toRangeList :: RSet a -> [(a, a)]+toRangeList (RSet xs) = Map.toAscList xs++-- | /O(n*log n)/. Create a set from a list of range pairs.+-- Note that unlike "Data.Set" and other binary trees, this always requires a full sort and traversal to create distinct, disjoint ranges before constructing the tree.+fromRangeList :: (Ord a, Enum a) => [(a, a)] -> RSet a+fromRangeList = unRangeList . normalizeRangeList++-- | /O(n)/. Convert a list-based 'RList.RSet' to a map-based 'RSet'.+fromRList :: RList.RSet a -> RSet a+fromRList = fromNormalizedRangeList . RList.toRangeList++-- | /O(n)/. Convert a map-based 'RSet' to a list-based 'RList.RSet'.+toRList :: RSet a -> RList.RSet a+toRList = RList.fromNormalizedRangeList . toRangeList++-- | /O(n)/. Convert a normalized, non-adjacent, ascending list of ranges to a set.+-- /The precondition is not checked./  In general you should only use this function on the result of 'toRangeList' or ensure 'valid' on the result.+fromNormalizedRangeList :: [(a, a)] -> RSet a+fromNormalizedRangeList = RSet . Map.fromDistinctAscList++-- | /O(n)/. Ensure that a set is valid. All functions should return valid sets except those with unchecked preconditions: 'fromAscList', 'fromNormalizedRangeList'+valid :: (Ord a, Enum a, Bounded a) => RSet a -> Bool+valid (RSet xm) = Map.valid xm && validRangeList (Map.toAscList xm)+

@@ -0,0 +1,164 @@+module IntMap (intMapProps) where++import Test.Tasty+import Test.Tasty.QuickCheck as QC++import qualified Data.Set as Set++import           Data.RangeSet.IntMap (RIntSet)+import qualified Data.RangeSet.IntMap as RSet++import Control.Applicative++import Data.Semigroup++import SetAction++toRSet :: SetAction Int -> RIntSet+toRSet AEmpty               = RSet.empty+toRSet (ASingleton a)       = RSet.singleton a+toRSet (AFromList l)        = RSet.fromList l+toRSet (AInsert a set)      = RSet.insert a $ toRSet set+toRSet (ADelete a set)      = RSet.delete a $ toRSet set+toRSet (AUnion a b)         = RSet.union (toRSet a) (toRSet b)+toRSet (ADifference a b)    = RSet.difference (toRSet a) (toRSet b)+toRSet (AIntersection a b)  = RSet.intersection (toRSet a) (toRSet b)++elementsProp :: SetAction Int -> Property+elementsProp seta = Set.elems (toSet seta) === RSet.elems (toRSet seta)++sizeProp :: SetAction Int -> Property+sizeProp seta = Set.size (toSet seta) === RSet.size (toRSet seta)++nullProp :: SetAction Int -> Property+nullProp seta = Set.null (toSet seta) === RSet.null (toRSet seta)++memberProp :: Int -> SetAction Int -> Property+memberProp x seta = Set.member x (toSet seta) === RSet.member x (toRSet seta)++notMemberProp :: Int -> RSetAction Int -> Property+notMemberProp x seta = Set.notMember x (rangeToSet seta) === RSet.notMember x (rangeToRSet seta)++lookupLTProp :: Int -> RSetAction Int -> Property+lookupLTProp x seta = Set.lookupLT x (rangeToSet seta) === RSet.lookupLT x (rangeToRSet seta)++lookupGTProp :: Int -> SetAction Int -> Property+lookupGTProp x seta = Set.lookupGT x (toSet seta) === RSet.lookupGT x (toRSet seta)++lookupLEProp :: Int -> SetAction Int -> Property+lookupLEProp x seta = Set.lookupLE x (toSet seta) === RSet.lookupLE x (toRSet seta)++lookupGEProp :: Int -> RSetAction Int -> Property+lookupGEProp x seta = Set.lookupGE x (rangeToSet seta) === RSet.lookupGE x (rangeToRSet seta)++isSubsetProp :: SetAction Int -> RSetAction Int -> Property+isSubsetProp seta setb = Set.isSubsetOf (toSet seta) (rangeToSet setb) === RSet.isSubsetOf (toRSet seta) (rangeToRSet setb)++splitProp :: Int -> RSetAction Int -> Property+splitProp x seta = Set.elems sl === RSet.elems rl .&&. sm === rm .&&. Set.elems su === RSet.elems ru where+  (sl, sm, su) = Set.splitMember x (rangeToSet seta)+  (rl, rm, ru) = RSet.splitMember x (rangeToRSet seta)++rangeToRSet :: RSetAction Int -> RIntSet+rangeToRSet RAEmpty               = RSet.empty+rangeToRSet (RASingleton a)       = RSet.singletonRange a+rangeToRSet (RAFromList l)        = RSet.fromRangeList l+rangeToRSet (RAInsert a set)      = RSet.insertRange a $ rangeToRSet set+rangeToRSet (RADelete a set)      = RSet.deleteRange a $ rangeToRSet set+rangeToRSet (RAUnion a b)         = RSet.union (rangeToRSet a) (rangeToRSet b)+rangeToRSet (RADifference a b)    = RSet.difference (rangeToRSet a) (rangeToRSet b)+rangeToRSet (RAIntersection a b)  = RSet.intersection (rangeToRSet a) (rangeToRSet b)++rangeProp :: RSetAction Int -> Property+rangeProp seta = Set.elems (rangeToSet seta) === RSet.elems (rangeToRSet seta)++ordered :: Ord a => [(a,a)] -> Bool+ordered rs = all lt $ zip rs (tail rs)+  where+    lt :: Ord a => ((a,a),(a,a)) -> Bool+    lt ((_,y),(u,_)) = y < u++pairOrdered :: Ord a => [(a, a)] -> Bool+pairOrdered = all (uncurry (<=))++orderedProp :: RSetAction Int -> Bool+orderedProp setAction = ordered rs && pairOrdered rs+  where rs = RSet.toRangeList $ rangeToRSet $ setAction++ascListProp :: RSetAction Int -> Property+ascListProp setAction = RSet.fromAscList (RSet.toAscList rs) === rs+  where rs = rangeToRSet setAction++-- Complement laws+complementProps :: TestTree+complementProps = testGroup "complement"+  [ QC.testProperty "definition"   (\a e -> RSet.member e (rs a) === RSet.notMember e (RSet.complement (rs a)))+  , QC.testProperty "involutive"   (\a -> rs a === RSet.complement (RSet.complement (rs a)))+  , QC.testProperty "(full \\\\)"  (\a -> RSet.complement (rs a) === RSet.full RSet.\\ (rs a))+  ]+  where rs = rangeToRSet :: RSetAction Int -> RIntSet++-- Min/Max laws++findMinProp :: RSetAction Int -> Property+findMinProp seta+  | Set.null s  = label "trivial" $ property True+  | otherwise   = Set.findMin s === RSet.findMin rs+  where s   = rangeToSet seta+        rs  = rangeToRSet seta++findMaxProp :: RSetAction Int -> Property+findMaxProp seta+  | Set.null s  = label "trivial" $ property True+  | otherwise   = Set.findMax s === RSet.findMax rs+  where s   = rangeToSet seta+        rs  = rangeToRSet seta++minMaxProps :: TestTree+minMaxProps = testGroup "Min/Max properties"+  [ QC.testProperty "findMin"  findMinProp+  , QC.testProperty "findMax"  findMaxProp+  ]++-- Monoid laws+monoidLaws :: TestTree+monoidLaws = testGroup "Monoid laws"+  [ QC.testProperty "left identity"   (\a -> rs a === mempty <> rs a)+  , QC.testProperty "right identity"  (\a -> rs a === rs a <> mempty)+  , QC.testProperty "associativity"   (\a b c -> rs a <> (rs b <> rs c) === (rs a <> rs b) <> rs c)+  ]+  where rs = rangeToRSet :: RSetAction Int -> RIntSet++validProp :: SetAction Int -> Property+validProp s = RSet.valid (toRSet s) === True++validRProp :: RSetAction Int -> Property+validRProp s = RSet.valid (rangeToRSet s) === True++invalidProp :: Property+invalidProp = RSet.valid (RSet.fromNormalizedRangeList [(-10,-1),(1,0),(2,3 :: Int)]) === False++-- All QuickCheck properties+intMapProps :: TestTree+intMapProps = testGroup "QuickCheck IntMap properties"+  [ QC.testProperty "element operations are similar" elementsProp+  , QC.testProperty "size is consistent" sizeProp+  , QC.testProperty "null operation is similar" nullProp+  , QC.testProperty "member operation is similar" memberProp+  , QC.testProperty "notMember operation is similar" notMemberProp+  , QC.testProperty "lookupLT operation is similar" lookupLTProp+  , QC.testProperty "lookupGT operation is similar" lookupGTProp+  , QC.testProperty "lookupLE operation is similar" lookupLEProp+  , QC.testProperty "lookupGE operation is similar" lookupGEProp+  , QC.testProperty "isSubset operation is similar" isSubsetProp+  , QC.testProperty "split operation is similar" splitProp+  , QC.testProperty "range operations is similar" rangeProp+  , QC.testProperty "ranges remain is ordered" orderedProp+  , QC.testProperty "fromAscList . toAscList === id" ascListProp+  , complementProps+  , minMaxProps+  , monoidLaws+  , QC.testProperty "item sets valid" validProp+  , QC.testProperty "range sets valid" validRProp+  , QC.testProperty "fromNormalizedRangeList invalid" invalidProp+  ]

@@ -0,0 +1,165 @@+module List (listProps) where++import Test.Tasty+import Test.Tasty.QuickCheck as QC++import qualified Data.Set as Set++import           Data.RangeSet.List (RSet)+import qualified Data.RangeSet.List as RSet++import Control.Applicative+import Data.Int++import Data.Semigroup++import SetAction++toRSet :: (Enum a, Ord a) => SetAction a -> RSet a+toRSet AEmpty               = RSet.empty+toRSet (ASingleton a)       = RSet.singleton a+toRSet (AFromList l)        = RSet.fromList l+toRSet (AInsert a set)      = RSet.insert a $ toRSet set+toRSet (ADelete a set)      = RSet.delete a $ toRSet set+toRSet (AUnion a b)         = RSet.union (toRSet a) (toRSet b)+toRSet (ADifference a b)    = RSet.difference (toRSet a) (toRSet b)+toRSet (AIntersection a b)  = RSet.intersection (toRSet a) (toRSet b)++elementsProp :: SetAction Int -> Property+elementsProp seta = Set.elems (toSet seta) === RSet.elems (toRSet seta)++sizeProp :: SetAction Int -> Property+sizeProp seta = Set.size (toSet seta) === RSet.size (toRSet seta)++nullProp :: SetAction Int -> Property+nullProp seta = Set.null (toSet seta) === RSet.null (toRSet seta)++memberProp :: Int -> SetAction Int -> Property+memberProp x seta = Set.member x (toSet seta) === RSet.member x (toRSet seta)++notMemberProp :: Int -> RSetAction Int -> Property+notMemberProp x seta = Set.notMember x (rangeToSet seta) === RSet.notMember x (rangeToRSet seta)++lookupLTProp :: Int -> RSetAction Int -> Property+lookupLTProp x seta = Set.lookupLT x (rangeToSet seta) === RSet.lookupLT x (rangeToRSet seta)++lookupGTProp :: Int -> SetAction Int -> Property+lookupGTProp x seta = Set.lookupGT x (toSet seta) === RSet.lookupGT x (toRSet seta)++lookupLEProp :: Int -> SetAction Int -> Property+lookupLEProp x seta = Set.lookupLE x (toSet seta) === RSet.lookupLE x (toRSet seta)++lookupGEProp :: Int -> RSetAction Int -> Property+lookupGEProp x seta = Set.lookupGE x (rangeToSet seta) === RSet.lookupGE x (rangeToRSet seta)++isSubsetProp :: SetAction Int -> RSetAction Int -> Property+isSubsetProp seta setb = Set.isSubsetOf (toSet seta) (rangeToSet setb) === RSet.isSubsetOf (toRSet seta) (rangeToRSet setb)++splitProp :: Int -> RSetAction Int -> Property+splitProp x seta = Set.elems sl === RSet.elems rl .&&. sm === rm .&&. Set.elems su === RSet.elems ru where+  (sl, sm, su) = Set.splitMember x (rangeToSet seta)+  (rl, rm, ru) = RSet.splitMember x (rangeToRSet seta)++rangeToRSet :: (Enum a, Ord a) => RSetAction a -> RSet a+rangeToRSet RAEmpty               = RSet.empty+rangeToRSet (RASingleton a)       = RSet.singletonRange a+rangeToRSet (RAFromList l)        = RSet.fromRangeList l+rangeToRSet (RAInsert a set)      = RSet.insertRange a $ rangeToRSet set+rangeToRSet (RADelete a set)      = RSet.deleteRange a $ rangeToRSet set+rangeToRSet (RAUnion a b)         = RSet.union (rangeToRSet a) (rangeToRSet b)+rangeToRSet (RADifference a b)    = RSet.difference (rangeToRSet a) (rangeToRSet b)+rangeToRSet (RAIntersection a b)  = RSet.intersection (rangeToRSet a) (rangeToRSet b)++rangeProp :: RSetAction Int8 -> Property+rangeProp seta = Set.elems (rangeToSet seta) === RSet.elems (rangeToRSet seta)++ordered :: Ord a => [(a,a)] -> Bool+ordered rs = all lt $ zip rs (tail rs)+  where+    lt :: Ord a => ((a,a),(a,a)) -> Bool+    lt ((_,y),(u,_)) = y < u++pairOrdered :: Ord a => [(a, a)] -> Bool+pairOrdered = all (uncurry (<=))++orderedProp :: RSetAction Int8 -> Bool+orderedProp setAction = ordered rs && pairOrdered rs+  where rs = RSet.toRangeList $ rangeToRSet $ setAction++ascListProp :: RSetAction Int8 -> Property+ascListProp setAction = RSet.fromAscList (RSet.toAscList rs) === rs+  where rs = rangeToRSet setAction++-- Complement laws+complementProps :: TestTree+complementProps = testGroup "complement"+  [ QC.testProperty "definition"   (\a e -> RSet.member e (rs a) === RSet.notMember e (RSet.complement (rs a)))+  , QC.testProperty "involutive"   (\a -> rs a === RSet.complement (RSet.complement (rs a)))+  , QC.testProperty "(full \\\\)"  (\a -> RSet.complement (rs a) === RSet.full RSet.\\ (rs a))+  ]+  where rs = rangeToRSet :: RSetAction Int -> RSet Int++-- Min/Max laws++findMinProp :: RSetAction Int8 -> Property+findMinProp seta+  | Set.null s  = label "trivial" $ property True+  | otherwise   = Set.findMin s === RSet.findMin rs+  where s   = rangeToSet seta+        rs  = rangeToRSet seta++findMaxProp :: RSetAction Int8 -> Property+findMaxProp seta+  | Set.null s  = label "trivial" $ property True+  | otherwise   = Set.findMax s === RSet.findMax rs+  where s   = rangeToSet seta+        rs  = rangeToRSet seta++minMaxProps :: TestTree+minMaxProps = testGroup "Min/Max properties"+  [ QC.testProperty "findMin"  findMinProp+  , QC.testProperty "findMax"  findMaxProp+  ]++-- Monoid laws+monoidLaws :: TestTree+monoidLaws = testGroup "Monoid laws"+  [ QC.testProperty "left identity"   (\a -> rs a === mempty <> rs a)+  , QC.testProperty "right identity"  (\a -> rs a === rs a <> mempty)+  , QC.testProperty "associativity"   (\a b c -> rs a <> (rs b <> rs c) === (rs a <> rs b) <> rs c)+  ]+  where rs = rangeToRSet :: RSetAction Int -> RSet Int++validProp :: SetAction Int -> Property+validProp s = RSet.valid (toRSet s) === True++validRProp :: RSetAction Int -> Property+validRProp s = RSet.valid (rangeToRSet s) === True++invalidProp :: Property+invalidProp = RSet.valid (RSet.fromNormalizedRangeList [(-10,-1),(1,0),(2,3 :: Int)]) === False++-- All QuickCheck properties+listProps :: TestTree+listProps = testGroup "QuickCheck List properties"+  [ QC.testProperty "element operations are similar" elementsProp+  , QC.testProperty "size is consistent" sizeProp+  , QC.testProperty "null operation is similar" nullProp+  , QC.testProperty "member operation is similar" memberProp+  , QC.testProperty "notMember operation is similar" notMemberProp+  , QC.testProperty "lookupLT operation is similar" lookupLTProp+  , QC.testProperty "lookupGT operation is similar" lookupGTProp+  , QC.testProperty "lookupLE operation is similar" lookupLEProp+  , QC.testProperty "lookupGE operation is similar" lookupGEProp+  , QC.testProperty "isSubset operation is similar" isSubsetProp+  , QC.testProperty "split operation is similar" splitProp+  , QC.testProperty "range operations is similar" rangeProp+  , QC.testProperty "ranges remain is ordered" orderedProp+  , QC.testProperty "fromAscList . toAscList === id" ascListProp+  , complementProps+  , minMaxProps+  , monoidLaws+  , QC.testProperty "item sets valid" validProp+  , QC.testProperty "range sets valid" validRProp+  , QC.testProperty "fromNormalizedRangeList invalid" invalidProp+  ]

@@ -0,0 +1,165 @@+module Map (mapProps) where++import Test.Tasty+import Test.Tasty.QuickCheck as QC++import qualified Data.Set as Set++import           Data.RangeSet.Map (RSet)+import qualified Data.RangeSet.Map as RSet++import Control.Applicative+import Data.Int++import Data.Semigroup++import SetAction++toRSet :: (Enum a, Ord a) => SetAction a -> RSet a+toRSet AEmpty               = RSet.empty+toRSet (ASingleton a)       = RSet.singleton a+toRSet (AFromList l)        = RSet.fromList l+toRSet (AInsert a set)      = RSet.insert a $ toRSet set+toRSet (ADelete a set)      = RSet.delete a $ toRSet set+toRSet (AUnion a b)         = RSet.union (toRSet a) (toRSet b)+toRSet (ADifference a b)    = RSet.difference (toRSet a) (toRSet b)+toRSet (AIntersection a b)  = RSet.intersection (toRSet a) (toRSet b)++elementsProp :: SetAction Int -> Property+elementsProp seta = Set.elems (toSet seta) === RSet.elems (toRSet seta)++sizeProp :: SetAction Int -> Property+sizeProp seta = Set.size (toSet seta) === RSet.size (toRSet seta)++nullProp :: SetAction Int -> Property+nullProp seta = Set.null (toSet seta) === RSet.null (toRSet seta)++memberProp :: Int -> SetAction Int -> Property+memberProp x seta = Set.member x (toSet seta) === RSet.member x (toRSet seta)++notMemberProp :: Int -> RSetAction Int -> Property+notMemberProp x seta = Set.notMember x (rangeToSet seta) === RSet.notMember x (rangeToRSet seta)++lookupLTProp :: Int -> RSetAction Int -> Property+lookupLTProp x seta = Set.lookupLT x (rangeToSet seta) === RSet.lookupLT x (rangeToRSet seta)++lookupGTProp :: Int -> SetAction Int -> Property+lookupGTProp x seta = Set.lookupGT x (toSet seta) === RSet.lookupGT x (toRSet seta)++lookupLEProp :: Int -> SetAction Int -> Property+lookupLEProp x seta = Set.lookupLE x (toSet seta) === RSet.lookupLE x (toRSet seta)++lookupGEProp :: Int -> RSetAction Int -> Property+lookupGEProp x seta = Set.lookupGE x (rangeToSet seta) === RSet.lookupGE x (rangeToRSet seta)++isSubsetProp :: SetAction Int -> RSetAction Int -> Property+isSubsetProp seta setb = Set.isSubsetOf (toSet seta) (rangeToSet setb) === RSet.isSubsetOf (toRSet seta) (rangeToRSet setb)++splitProp :: Int -> RSetAction Int -> Property+splitProp x seta = Set.elems sl === RSet.elems rl .&&. sm === rm .&&. Set.elems su === RSet.elems ru where+  (sl, sm, su) = Set.splitMember x (rangeToSet seta)+  (rl, rm, ru) = RSet.splitMember x (rangeToRSet seta)++rangeToRSet :: (Enum a, Ord a) => RSetAction a -> RSet a+rangeToRSet RAEmpty               = RSet.empty+rangeToRSet (RASingleton a)       = RSet.singletonRange a+rangeToRSet (RAFromList l)        = RSet.fromRangeList l+rangeToRSet (RAInsert a set)      = RSet.insertRange a $ rangeToRSet set+rangeToRSet (RADelete a set)      = RSet.deleteRange a $ rangeToRSet set+rangeToRSet (RAUnion a b)         = RSet.union (rangeToRSet a) (rangeToRSet b)+rangeToRSet (RADifference a b)    = RSet.difference (rangeToRSet a) (rangeToRSet b)+rangeToRSet (RAIntersection a b)  = RSet.intersection (rangeToRSet a) (rangeToRSet b)++rangeProp :: RSetAction Int8 -> Property+rangeProp seta = Set.elems (rangeToSet seta) === RSet.elems (rangeToRSet seta)++ordered :: Ord a => [(a,a)] -> Bool+ordered rs = all lt $ zip rs (tail rs)+  where+    lt :: Ord a => ((a,a),(a,a)) -> Bool+    lt ((_,y),(u,_)) = y < u++pairOrdered :: Ord a => [(a, a)] -> Bool+pairOrdered = all (uncurry (<=))++orderedProp :: RSetAction Int8 -> Bool+orderedProp setAction = ordered rs && pairOrdered rs+  where rs = RSet.toRangeList $ rangeToRSet $ setAction++ascListProp :: RSetAction Int8 -> Property+ascListProp setAction = RSet.fromAscList (RSet.toAscList rs) === rs+  where rs = rangeToRSet setAction++-- Complement laws+complementProps :: TestTree+complementProps = testGroup "complement"+  [ QC.testProperty "definition"   (\a e -> RSet.member e (rs a) === RSet.notMember e (RSet.complement (rs a)))+  , QC.testProperty "involutive"   (\a -> rs a === RSet.complement (RSet.complement (rs a)))+  , QC.testProperty "(full \\\\)"  (\a -> RSet.complement (rs a) === RSet.full RSet.\\ (rs a))+  ]+  where rs = rangeToRSet :: RSetAction Int -> RSet Int++-- Min/Max laws++findMinProp :: RSetAction Int8 -> Property+findMinProp seta+  | Set.null s  = label "trivial" $ property True+  | otherwise   = Set.findMin s === RSet.findMin rs+  where s   = rangeToSet seta+        rs  = rangeToRSet seta++findMaxProp :: RSetAction Int8 -> Property+findMaxProp seta+  | Set.null s  = label "trivial" $ property True+  | otherwise   = Set.findMax s === RSet.findMax rs+  where s   = rangeToSet seta+        rs  = rangeToRSet seta++minMaxProps :: TestTree+minMaxProps = testGroup "Min/Max properties"+  [ QC.testProperty "findMin"  findMinProp+  , QC.testProperty "findMax"  findMaxProp+  ]++-- Monoid laws+monoidLaws :: TestTree+monoidLaws = testGroup "Monoid laws"+  [ QC.testProperty "left identity"   (\a -> rs a === mempty <> rs a)+  , QC.testProperty "right identity"  (\a -> rs a === rs a <> mempty)+  , QC.testProperty "associativity"   (\a b c -> rs a <> (rs b <> rs c) === (rs a <> rs b) <> rs c)+  ]+  where rs = rangeToRSet :: RSetAction Int -> RSet Int++validProp :: SetAction Int -> Property+validProp s = RSet.valid (toRSet s) === True++validRProp :: RSetAction Int -> Property+validRProp s = RSet.valid (rangeToRSet s) === True++invalidProp :: Property+invalidProp = RSet.valid (RSet.fromNormalizedRangeList [(-10,-1),(1,0),(2,3 :: Int)]) === False++-- All QuickCheck properties+mapProps :: TestTree+mapProps = testGroup "QuickCheck Map properties"+  [ QC.testProperty "element operations are similar" elementsProp+  , QC.testProperty "size is consistent" sizeProp+  , QC.testProperty "null operation is similar" nullProp+  , QC.testProperty "member operation is similar" memberProp+  , QC.testProperty "notMember operation is similar" notMemberProp+  , QC.testProperty "lookupLT operation is similar" lookupLTProp+  , QC.testProperty "lookupGT operation is similar" lookupGTProp+  , QC.testProperty "lookupLE operation is similar" lookupLEProp+  , QC.testProperty "lookupGE operation is similar" lookupGEProp+  , QC.testProperty "isSubset operation is similar" isSubsetProp+  , QC.testProperty "split operation is similar" splitProp+  , QC.testProperty "range operations is similar" rangeProp+  , QC.testProperty "ranges remain is ordered" orderedProp+  , QC.testProperty "fromAscList . toAscList === id" ascListProp+  , complementProps+  , minMaxProps+  , monoidLaws+  , QC.testProperty "item sets valid" validProp+  , QC.testProperty "range sets valid" validRProp+  , QC.testProperty "fromNormalizedRangeList invalid" invalidProp+  ]

@@ -0,0 +1,81 @@+module SetAction where++import Test.Tasty.QuickCheck as QC++import           Data.Set (Set)+import qualified Data.Set as Set++import Control.Applicative++data SetAction a = AEmpty+                 | ASingleton a+                 | AFromList [a]+                 | AInsert a (SetAction a)+                 | ADelete a (SetAction a)+                 | AUnion (SetAction a) (SetAction a)+                 | ADifference (SetAction a) (SetAction a)+                 | AIntersection (SetAction a) (SetAction a)+  deriving (Show)++instance Arbitrary a => Arbitrary (SetAction a) where+  arbitrary = sized arbitrary'+    where arbitrary' n+            | n <= 0     = oneof [pure AEmpty, ASingleton <$> arbitrary]+            | otherwise  = oneof [ pure AEmpty+                                 , ASingleton <$> arbitrary+                                 , AFromList <$> arbitrary+                                 , AInsert <$> arbitrary <*> arbitrary1+                                 , ADelete <$> arbitrary <*> arbitrary1+                                 , AUnion <$> arbitrary2 <*> arbitrary2+                                 , ADifference <$> arbitrary2 <*> arbitrary2+                                 , AIntersection <$> arbitrary2 <*> arbitrary2+                                 ]+                              where arbitrary1 = arbitrary' $ n - 1+                                    arbitrary2 = arbitrary' $ n `div` 2++toSet :: (Ord a) => SetAction a -> Set a+toSet AEmpty               = Set.empty+toSet (ASingleton a)       = Set.singleton a+toSet (AFromList l)        = Set.fromList l+toSet (AInsert a set)      = Set.insert a $ toSet set+toSet (ADelete a set)      = Set.delete a $ toSet set+toSet (AUnion a b)         = Set.union (toSet a) (toSet b)+toSet (ADifference a b)    = Set.difference (toSet a) (toSet b)+toSet (AIntersection a b)  = Set.intersection (toSet a) (toSet b)++data RSetAction a = RAEmpty+                  | RASingleton (a, a)+                  | RAFromList [(a, a)]+                  | RAInsert (a, a) (RSetAction a)+                  | RADelete (a, a) (RSetAction a)+                  | RAUnion (RSetAction a) (RSetAction a)+                  | RADifference (RSetAction a) (RSetAction a)+                  | RAIntersection (RSetAction a) (RSetAction a)+  deriving (Show)++instance Arbitrary a => Arbitrary (RSetAction a) where+  arbitrary = sized arbitrary'+    where arbitrary' n+            | n <= 0     = oneof [pure RAEmpty, RASingleton <$> arbitrary]+            | otherwise  = oneof [ pure RAEmpty+                                 , RASingleton <$> arbitrary+                                 , RAFromList <$> arbitrary+                                 , RAInsert <$> arbitrary <*> arbitrary1+                                 , RADelete <$> arbitrary <*> arbitrary1+                                 , RAUnion <$> arbitrary2 <*> arbitrary2+                                 , RADifference <$> arbitrary2 <*> arbitrary2+                                 , RAIntersection <$> arbitrary2 <*> arbitrary2+                                 ]+                              where arbitrary1 = arbitrary' $ n - 1+                                    arbitrary2 = arbitrary' $ n `div` 2++rangeToSet :: (Enum a, Ord a) => RSetAction a -> Set a+rangeToSet RAEmpty               = Set.empty+rangeToSet (RASingleton a)       = Set.fromList $ uncurry enumFromTo a+rangeToSet (RAFromList l)        = Set.fromList $ concatMap (uncurry enumFromTo) l+rangeToSet (RAInsert a set)      = foldr Set.insert (rangeToSet set) $ uncurry enumFromTo a+rangeToSet (RADelete a set)      = foldr Set.delete (rangeToSet set) $ uncurry enumFromTo a+rangeToSet (RAUnion a b)         = Set.union (rangeToSet a) (rangeToSet b)+rangeToSet (RADifference a b)    = Set.difference (rangeToSet a) (rangeToSet b)+rangeToSet (RAIntersection a b)  = Set.intersection (rangeToSet a) (rangeToSet b)+

@@ -1,197 +1,11 @@ import Test.Tasty-import Test.Tasty.QuickCheck as QC -import Data.Set (Set)-import qualified Data.Set as Set--import Data.RangeSet.List (RSet)-import qualified Data.RangeSet.List as RSet--import Control.Applicative-import Data.Int--import Data.Semigroup+import IntMap+import List+import Map  main :: IO () main = defaultMain tests  tests :: TestTree-tests = testGroup "Tests" [qcProps]--data SetAction a = AEmpty-                 | ASingleton a-                 | AFromList [a]-                 | AInsert a (SetAction a)-                 | ADelete a (SetAction a)-                 | AUnion (SetAction a) (SetAction a)-                 | ADifference (SetAction a) (SetAction a)-                 | AIntersection (SetAction a) (SetAction a)-  deriving (Show)--instance Arbitrary a => Arbitrary (SetAction a) where-  arbitrary = sized arbitrary'-    where arbitrary' n-            | n <= 0     = oneof [pure AEmpty, ASingleton <$> arbitrary]-            | otherwise  = oneof [ pure AEmpty-                                 , ASingleton <$> arbitrary-                                 , AFromList <$> arbitrary-                                 , AInsert <$> arbitrary <*> arbitrary1-                                 , ADelete <$> arbitrary <*> arbitrary1-                                 , AUnion <$> arbitrary2 <*> arbitrary2-                                 , ADifference <$> arbitrary2 <*> arbitrary2-                                 , AIntersection <$> arbitrary2 <*> arbitrary2-                                 ]-                              where arbitrary1 = arbitrary' $ n - 1-                                    arbitrary2 = arbitrary' $ n `div` 2--toSet :: (Ord a) => SetAction a -> Set a-toSet AEmpty               = Set.empty-toSet (ASingleton a)       = Set.singleton a-toSet (AFromList l)        = Set.fromList l-toSet (AInsert a set)      = Set.insert a $ toSet set-toSet (ADelete a set)      = Set.delete a $ toSet set-toSet (AUnion a b)         = Set.union (toSet a) (toSet b)-toSet (ADifference a b)    = Set.difference (toSet a) (toSet b)-toSet (AIntersection a b)  = Set.intersection (toSet a) (toSet b)--toRSet :: (Enum a, Ord a) => SetAction a -> RSet a-toRSet AEmpty               = RSet.empty-toRSet (ASingleton a)       = RSet.singleton a-toRSet (AFromList l)        = RSet.fromList l-toRSet (AInsert a set)      = RSet.insert a $ toRSet set-toRSet (ADelete a set)      = RSet.delete a $ toRSet set-toRSet (AUnion a b)         = RSet.union (toRSet a) (toRSet b)-toRSet (ADifference a b)    = RSet.difference (toRSet a) (toRSet b)-toRSet (AIntersection a b)  = RSet.intersection (toRSet a) (toRSet b)--elementsProp :: SetAction Int -> Property-elementsProp seta = Set.elems (toSet seta) === RSet.elems (toRSet seta)--sizeProp :: SetAction Int -> Property-sizeProp seta = Set.size (toSet seta) === RSet.size (toRSet seta)--nullProp :: SetAction Int -> Property-nullProp seta = Set.null (toSet seta) === RSet.null (toRSet seta)--memberProp :: Int -> SetAction Int -> Property-memberProp x seta = Set.member x (toSet seta) === RSet.member x (toRSet seta)--notMemberProp :: Int -> SetAction Int -> Property-notMemberProp x seta = Set.notMember x (toSet seta) === RSet.notMember x (toRSet seta)--data RSetAction a = RAEmpty-                  | RASingleton (a, a)-                  | RAFromList [(a, a)]-                  | RAInsert (a, a) (RSetAction a)-                  | RADelete (a, a) (RSetAction a)-                  | RAUnion (RSetAction a) (RSetAction a)-                  | RADifference (RSetAction a) (RSetAction a)-                  | RAIntersection (RSetAction a) (RSetAction a)-  deriving (Show)--instance Arbitrary a => Arbitrary (RSetAction a) where-  arbitrary = sized arbitrary'-    where arbitrary' n-            | n <= 0     = oneof [pure RAEmpty, RASingleton <$> arbitrary]-            | otherwise  = oneof [ pure RAEmpty-                                 , RASingleton <$> arbitrary-                                 , RAFromList <$> arbitrary-                                 , RAInsert <$> arbitrary <*> arbitrary1-                                 , RADelete <$> arbitrary <*> arbitrary1-                                 , RAUnion <$> arbitrary2 <*> arbitrary2-                                 , RADifference <$> arbitrary2 <*> arbitrary2-                                 , RAIntersection <$> arbitrary2 <*> arbitrary2-                                 ]-                              where arbitrary1 = arbitrary' $ n - 1-                                    arbitrary2 = arbitrary' $ n `div` 2--rangeToSet :: (Enum a, Ord a) => RSetAction a -> Set a-rangeToSet RAEmpty               = Set.empty-rangeToSet (RASingleton a)       = Set.fromList $ uncurry enumFromTo a-rangeToSet (RAFromList l)        = Set.fromList $ concatMap (uncurry enumFromTo) l-rangeToSet (RAInsert a set)      = foldr Set.insert (rangeToSet set) $ uncurry enumFromTo a-rangeToSet (RADelete a set)      = foldr Set.delete (rangeToSet set) $ uncurry enumFromTo a-rangeToSet (RAUnion a b)         = Set.union (rangeToSet a) (rangeToSet b)-rangeToSet (RADifference a b)    = Set.difference (rangeToSet a) (rangeToSet b)-rangeToSet (RAIntersection a b)  = Set.intersection (rangeToSet a) (rangeToSet b)--rangeToRSet :: (Enum a, Ord a) => RSetAction a -> RSet a-rangeToRSet RAEmpty               = RSet.empty-rangeToRSet (RASingleton a)       = RSet.singletonRange a-rangeToRSet (RAFromList l)        = RSet.fromRangeList l-rangeToRSet (RAInsert a set)      = RSet.insertRange a $ rangeToRSet set-rangeToRSet (RADelete a set)      = RSet.deleteRange a $ rangeToRSet set-rangeToRSet (RAUnion a b)         = RSet.union (rangeToRSet a) (rangeToRSet b)-rangeToRSet (RADifference a b)    = RSet.difference (rangeToRSet a) (rangeToRSet b)-rangeToRSet (RAIntersection a b)  = RSet.intersection (rangeToRSet a) (rangeToRSet b)--rangeProp :: RSetAction Int8 -> Property-rangeProp seta = Set.elems (rangeToSet seta) === RSet.elems (rangeToRSet seta)--ordered :: Ord a => [(a,a)] -> Bool-ordered rs = all lt $ zip rs (tail rs)-  where-    lt :: Ord a => ((a,a),(a,a)) -> Bool-    lt ((_,y),(u,_)) = y < u--pairOrdered :: Ord a => [(a, a)] -> Bool-pairOrdered = all (uncurry (<=))--orderedProp :: RSetAction Int8 -> Bool-orderedProp setAction = ordered rs && pairOrdered rs-  where rs = RSet.toRangeList . rangeToRSet $ setAction---- Complement laws-complementProps :: TestTree-complementProps = testGroup "complement"-  [ QC.testProperty "definition"   (\a e -> RSet.member e (rs a) === RSet.notMember e (RSet.complement (rs a)))-  , QC.testProperty "involutive"   (\a -> rs a === RSet.complement (RSet.complement (rs a)))-  , QC.testProperty "(full \\\\)"  (\a -> RSet.complement (rs a) === RSet.full RSet.\\ (rs a))-  ]-  where rs = rangeToRSet :: RSetAction Int -> RSet Int---- Min/Max laws--findMinProp :: RSetAction Int8 -> Property-findMinProp seta-  | Set.null s  = label "trivial" $ property True-  | otherwise   = Set.findMin s === RSet.findMin rs-  where s   = rangeToSet seta-        rs  = rangeToRSet seta--findMaxProp :: RSetAction Int8 -> Property-findMaxProp seta-  | Set.null s  = label "trivial" $ property True-  | otherwise   = Set.findMax s === RSet.findMax rs-  where s   = rangeToSet seta-        rs  = rangeToRSet seta--minMaxProps :: TestTree-minMaxProps = testGroup "Min/Max properties"-  [ QC.testProperty "findMin"  findMinProp-  , QC.testProperty "findMax"  findMaxProp-  ]---- Monoid laws-monoidLaws :: TestTree-monoidLaws = testGroup "Monoid laws"-  [ QC.testProperty "left identity"   (\a -> rs a === mempty <> rs a)-  , QC.testProperty "right identity"  (\a -> rs a === rs a <> mempty)-  , QC.testProperty "associativity"   (\a b c -> rs a <> (rs b <> rs c) === (rs a <> rs b) <> rs c)-  ]-  where rs = rangeToRSet :: RSetAction Int -> RSet Int---- All QuickCheck properties-qcProps :: TestTree-qcProps = testGroup "QuickCheck properties"-  [ QC.testProperty "element operations are similar" elementsProp-  , QC.testProperty "size is consistent" sizeProp-  , QC.testProperty "null operation is similar" nullProp-  , QC.testProperty "member operation is similar" memberProp-  , QC.testProperty "notMember operation is similar" notMemberProp-  , QC.testProperty "range operations is similar" rangeProp-  , QC.testProperty "ranges remain is ordered" orderedProp-  , complementProps-  , minMaxProps-  , monoidLaws-  ]+tests = testGroup "Tests" [listProps, mapProps, intMapProps]