range-set-list (empty) → 0.0.1
raw patch · 5 files changed
+386/−0 lines, 5 filesdep +basedep +containersdep +range-set-listsetup-changed
Dependencies added: base, containers, range-set-list, tasty, tasty-quickcheck
Files
- Data/RangeSet/List.hs +208/−0
- LICENSE +21/−0
- Setup.hs +2/−0
- range-set-list.cabal +33/−0
- tests/Tests.hs +122/−0
+ Data/RangeSet/List.hs view
@@ -0,0 +1,208 @@+{- |+Module : Data.RangeSet.List+Description : A trivial implementation of range sets+Copyright : (c) Oleg Grenrus 2014+License : MIT++Maintainer : oleg.grenrus@iki.fi+Stability : experimental+Portability : non-portable (tested with GHC only)++A trivial implementation of range sets.++This module is intended to be imported qualified, to avoid name+clashes with Prelude functions, e.g.++> import Data.RangeSet.List (RSet)+> import qualified Data.RangeSet.List as RSet++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.++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.+-}++module Data.RangeSet.List (+ -- * Range set type+ RSet++ -- * Operators+ , (\\)++ -- * Query+ , null+ , member+ , notMember++ -- * Construction+ , empty+ , singleton+ , singletonRange+ , insert+ , insertRange+ , delete+ , deleteRange++ -- * Combine+ , union+ , difference+ , intersection++ -- * Conversion+ , elems+ , toList+ , fromList+ , toRangeList+ , fromRangeList++ ) where++import Prelude hiding (filter,foldl,foldr,null,map)+import qualified Prelude++import Data.Monoid (Monoid(..))++-- | Internally set is represented as list of distinct inclusive ranges.+newtype RSet a = RSet [(a, a)]+ deriving (Eq, Ord)++instance Show a => Show (RSet a) where+ show (RSet xs) = "fromRangeList " ++ show xs++instance (Ord a, Enum a) => Monoid (RSet a) where+ mempty = empty+ mappend = union++{- 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 = Prelude.null . toRangeList++-- | /O(n)/. Is the element in the set?+member :: (Ord a, Enum a) => a -> RSet a -> Bool+member x (RSet xs) = any f xs+ where f (a, b) = a <= x && x <= b++-- | /O(n)/. Is the element not in the set?+notMember :: (Ord a, Enum a) => a -> RSet a -> Bool+notMember a r = not $ member a r++{- Construction -}++-- | /O(1)/. The empty set.+empty :: RSet a+empty = RSet []++-- | /O(1)/. Create a singleton set.+singleton :: a -> RSet a+singleton x = RSet [(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)]++{- Construction -}++-- | /O(n)/. Insert an element in a set.+insert :: (Ord a, Enum a) => a -> RSet a -> RSet a+insert x set = insertRange (x, x) set++-- | /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)+ | 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++-- | /O(n). Delete an element from a set.+delete :: (Ord a, Enum a) => a -> RSet a -> RSet a+delete x set = deleteRange (x, x) set++-- | /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)+ | 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++{- Combination -}++-- | /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++-- | /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++-- | /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)++{- Conversion -}++-- | /O(n*r)/. Convert the set to a list of elements. /r/ is the size of longest range.+elems :: Enum a => RSet a -> [a]+elems = toList++-- | /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.+fromList :: (Ord a, Enum a) => [a] -> RSet a+fromList = fromRangeList . Prelude.map f+ where f a = (a, a)++-- | /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.+fromRangeList :: (Ord a, Enum a) => [(a, a)] -> RSet a+fromRangeList = Prelude.foldr insertRange empty
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 Oleg Grenrus++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ range-set-list.cabal view
@@ -0,0 +1,33 @@+name: range-set-list+version: 0.0.1+synopsis: Memory efficient sets with continuous ranges of elements. List based implementation.+description: Memory efficient sets with continuous ranges of elements. List based implementation. Interface mimics "Data.Set" interface where possible.+homepage: https://github.com/phadej/range-set-list+bug-reports: https://github.com/phadej/range-set-list/issues+license: MIT+license-file: LICENSE+stability: experimental+author: Oleg Grenrus+maintainer: oleg.grenrus@iki.fi+copyright: Copyright (c) 2013 Oleg Grenrus+category: Data Structures+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Data.RangeSet.List+ build-depends: base >=4.6 && <5+ default-language: Haskell98+ ghc-options: -Wall++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs+ ghc-options: -Wall+ build-depends: base >=4.6 && <5,+ containers >= 0.5 && <0.6,+ tasty >= 0.7,+ tasty-quickcheck >= 0.3,+ range-set-list
+ tests/Tests.hs view
@@ -0,0 +1,122 @@+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++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 -> Bool+elementsProp seta = Set.elems (toSet seta) == RSet.elems (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 -> Bool+rangeProp seta = Set.elems (rangeToSet seta) == RSet.elems (rangeToRSet seta)+++qcProps :: TestTree+qcProps = testGroup "QuickCheck properties"+ [ QC.testProperty "element operations similar" elementsProp+ , QC.testProperty "range operations similar" rangeProp+ ]