diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2017 Daniel Lovasko +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/rset.cabal b/rset.cabal new file mode 100644 --- /dev/null +++ b/rset.cabal @@ -0,0 +1,45 @@ +name: rset +version: 1.0.0 +synopsis: Range set +description: Data structure that stores a set of ranges. It provides an + API similar to the Data.Set module. Types stored in the + data structure have to be instances of Eq, Ord and Enum + typeclasses. +homepage: https://github.com/lovasko/rset +license: OtherLicense +license-file: LICENSE +author: Daniel Lovasko +maintainer: Daniel Lovasko +copyright: 2017 Daniel Lovasko +category: Data +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.Set.Range + other-modules: Data.Set.Range.Combine + , Data.Set.Range.General + , Data.Set.Range.List + , Data.Set.Range.Modify + , Data.Set.Range.Overlap + , Data.Set.Range.Query + , Data.Set.Range.Types + build-depends: base >= 4.7 && < 5 + , safe + default-language: Haskell2010 + +test-suite rset-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Prop.hs + build-depends: base >= 4.7 && < 5 + , QuickCheck + , rset + , safe + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/lovasko/rset diff --git a/src/Data/Set/Range.hs b/src/Data/Set/Range.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range.hs @@ -0,0 +1,51 @@ +{- | +Module : Data.Set.Range +Description : Data structure that stores a set of ranges of types that + implement Eq, Ord and Enum typeclasses. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range +( Range +, RangeSet + +-- general +, empty +, null +, size + +-- list conversions +, fromAscList +, fromDescList +, fromList +, toList + +-- access +, insertPoint +, insertRange +, removePoint +, removeRange + +-- member testing +, queryPoint +, queryRange + +-- combinations +, difference +, intersect +, union +) where + +import Prelude hiding (null) + +import Data.Set.Range.Combine +import Data.Set.Range.General +import Data.Set.Range.List +import Data.Set.Range.Modify +import Data.Set.Range.Query +import Data.Set.Range.Types diff --git a/src/Data/Set/Range/Combine.hs b/src/Data/Set/Range/Combine.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/Combine.hs @@ -0,0 +1,85 @@ +{- | +Module : Data.Set.Range.Combine +Description : Combining multiple range sets into one. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.Combine +( difference +, intersect +, union +) where + +import Data.Set.Range.Overlap +import Data.Set.Range.Types + + +-- | Merge all adjacent ranges. This function assumes that the range set is +-- sorted by its first range parameter. +merge :: (Eq a, Enum a) + => RangeSet a -- ^ old range set + -> RangeSet a -- ^ new range set +merge [] = [] +merge [xs] = [xs] +merge ((a,b) : (c,d) : xs) + | b == c = merge ((a,d) : xs) + | succ b == c = merge ((a,d) : xs) + | otherwise = (a,b) : merge ((c,d) : xs) + +-- | Subtract a range set from another range. +difference :: (Ord a, Enum a) + => RangeSet a -- ^ first range set + -> RangeSet a -- ^ second range set + -> RangeSet a -- ^ difference of two range sets +difference xs [] = xs +difference [] _ = [] +difference ((a,b) : xs) ((c,d) : ys) = go $ overlap (a,b) (c,d) + where + go Equal = difference xs ys + go FstSmaller = (a,b) : difference xs ((c,d) : ys) + go FstInside = difference xs ((c,d) : ys) + go FstOverlap = (a,pred c) : difference xs ((succ b,d) : ys) + go SndSmaller = difference ((a,b) : xs) ys + go SndInside + | a == c = difference ((succ d,b) : xs) ys + | otherwise = (a,pred c) : difference ((succ d,b) : xs) ys + go SndOverlap = difference ((succ d,b) : xs) ys + +-- | Create an intersection of two range sets. +intersect :: (Ord a, Enum a) + => RangeSet a -- ^ first range set + -> RangeSet a -- ^ second range set + -> RangeSet a -- ^ intersection of two range sets +intersect _ [] = [] +intersect [] _ = [] +intersect ((a,b) : xs) ((c,d) : ys) = merge $ go $ overlap (a,b) (c,d) + where + go Equal = (a,b) : intersect xs ys + go FstSmaller = intersect xs ((c,d) : ys) + go FstInside = (a,b) : intersect xs ((b,d) : ys) + go FstOverlap = (c,b) : intersect xs ((b,d) : ys) + go SndInside = (c,d) : intersect ((d,b) : xs) ys + go SndSmaller = intersect ((a,b) : xs) ys + go SndOverlap = (a,d) : intersect ((d,b) : xs) ys + +-- | Create an union of two range sets. +union :: (Ord a, Enum a) + => RangeSet a -- ^ first range set + -> RangeSet a -- ^ second range set + -> RangeSet a -- ^ union of two range sets +union xs [] = xs +union [] ys = ys +union ((a,b) : xs) ((c,d) : ys) = merge $ go $ overlap (a,b) (c,d) + where + go Equal = (a,b) : union xs ys + go FstSmaller = (a,b) : union xs ((c,d) : ys) + go FstInside = union xs ((c,d) : ys) + go FstOverlap = (a,b) : union xs ((b,d) : ys) + go SndSmaller = (c,d) : union ((a,b) : xs) ys + go SndInside = union ((a,b) : xs) ys + go SndOverlap = (c,d) : union ((d,b) : xs) ys diff --git a/src/Data/Set/Range/General.hs b/src/Data/Set/Range/General.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/General.hs @@ -0,0 +1,40 @@ +{- | +Module : Data.Set.Range.General +Description : General functions that provide information about a range set. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.General +( empty +, null +, size +) where + +import qualified Data.List as L +import Prelude hiding (null) + +import Data.Set.Range.Types + + +-- | Create an empty range set. +empty + :: RangeSet a -- ^ range set +empty = [] + +-- | Test if the range set does not contain any points. +null + :: RangeSet a -- ^ range set + -> Bool -- ^ decision +null [] = True +null _ = False + +-- | Count the number of unique points stored in the range set. +size :: (Num n, Enum a) + => RangeSet a -- ^ range set + -> n -- ^ number of points +size xs = sum $ map (L.genericLength . uncurry enumFromTo) xs diff --git a/src/Data/Set/Range/List.hs b/src/Data/Set/Range/List.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/List.hs @@ -0,0 +1,57 @@ +{- | +Module : Data.Set.Range.List +Description : Conversion of range sets to and from lists. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.List +( fromAscList +, fromDescList +, fromList +, toList +) where + +import Data.Set.Range.General +import Data.Set.Range.Modify +import Data.Set.Range.Types + + +-- | Create a range set from a list of points. The ordering of the points is +-- not important. The list can contain duplicates. +fromList :: (Ord a, Enum a) + => [a] -- ^ list of points + -> RangeSet a -- ^ range set +fromList = foldr insertPoint empty + +-- | Create a range set from a list of ascending points. The list can contain +-- duplicates. +fromAscList :: (Ord a, Enum a) + => [a] -- ^ list of ascending points + -> RangeSet a -- ^ range set +fromAscList = foldr combine [] + where + combine p [] = [(p,p)] + combine p ((a,b) : xs) + | p < a && succ p == a = (p,b) : xs + | b < p && succ b == p = (a,p) : xs + | a <= p && p <= b = (a,b) : xs + | otherwise = (p,p) : (a,b) : xs + +-- | Create a range set from a list of descending points. The list can contain +-- duplicates. +fromDescList :: (Ord a, Enum a) + => [a] -- ^ list of ascending points + -> RangeSet a -- ^ range set +fromDescList = reverse . fromAscList + +-- | Convert the range set into a list of points. +toList :: Enum a + => RangeSet a -- ^ range set + -> [a] -- ^ points +toList [] = [] +toList ((a,b) : xs) = [a .. b] ++ toList xs diff --git a/src/Data/Set/Range/Modify.hs b/src/Data/Set/Range/Modify.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/Modify.hs @@ -0,0 +1,49 @@ +{- | +Module : Data.Set.Range.Modify +Description : Basic functions to modify the contents of a range set. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.Modify +( insertPoint +, insertRange +, removePoint +, removeRange +) where + +import Data.Set.Range.Combine +import Data.Set.Range.Types + + +-- | Insert a single point into the range set. +insertPoint :: (Ord a, Enum a) + => a -- ^ point + -> RangeSet a -- ^ old range set + -> RangeSet a -- ^ new range set +insertPoint p = union [(p,p)] + +-- | Insert a range into the range set. +insertRange :: (Ord a, Enum a) + => (a,a) -- ^ range + -> RangeSet a -- ^ old range set + -> RangeSet a -- ^ new range set +insertRange r = union [r] + +-- | Remove a single point from the range set. +removePoint :: (Ord a, Enum a) + => a + -> RangeSet a + -> RangeSet a +removePoint p = flip difference [(p,p)] + +-- | Remove a range from the range set. +removeRange :: (Ord a, Enum a) + => (a,a) + -> RangeSet a + -> RangeSet a +removeRange r = flip difference [r] diff --git a/src/Data/Set/Range/Overlap.hs b/src/Data/Set/Range/Overlap.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/Overlap.hs @@ -0,0 +1,41 @@ +{- | +Module : Data.Set.Range.Overlap +Description : Computation of overlap (or lack thereof) between two ranges. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.Overlap +( Overlap(..) +, overlap +) where + +-- | Comparison of two ranges. +data Overlap + = Equal -- ^ ranges are equal + | FstSmaller -- ^ no overlap + first range is smaller + | FstInside -- ^ first range is inside the second one + | FstOverlap -- ^ first range is smaller and overlaps with second one + | SndSmaller -- ^ no overlap + second range is smaller + | SndInside -- ^ second range is inside the first one + | SndOverlap -- ^ second range is smaller and overlaps with first one + +-- | Compute the overlap relationship between to ranges. +overlap :: Ord a + => (a,a) -- ^ first range + -> (a,a) -- ^ second range + -> Overlap -- ^ overap relationship +overlap (a,b) (c,d) + | a == c && b == d = Equal + | a < c && b < c && a < d && b < d = FstSmaller + | between a c d && between b c d = FstInside + | a < c && between b c d = FstOverlap + | c < a && d < b && c < b && d < a = SndSmaller + | between c a b && between d a b = SndInside + | otherwise = SndOverlap + where + between x lo hi = lo <= x && x <= hi diff --git a/src/Data/Set/Range/Query.hs b/src/Data/Set/Range/Query.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/Query.hs @@ -0,0 +1,42 @@ +{- | +Module : Data.Set.Range.Query +Description : Membership testing. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.Query +( queryPoint +, queryRange +) where + +import Data.Set.Range.Overlap +import Data.Set.Range.Types + + +-- | Test whether a point is included in the range set. +queryPoint :: Ord a + => a -- ^ point + -> RangeSet a -- ^ range + -> Bool -- ^ decision +queryPoint p = queryRange (p,p) + +-- | Test whether a range is included in the range set. +queryRange :: Ord a + => (a,a) -- ^ range + -> RangeSet a -- ^ range set + -> Bool -- ^ decision +queryRange _ [] = False +queryRange x (r : rs) = go $ overlap x r + where + go Equal = True + go FstSmaller = False + go FstInside = True + go FstOverlap = False + go SndSmaller = queryRange x rs + go SndInside = False + go SndOverlap = False diff --git a/src/Data/Set/Range/Types.hs b/src/Data/Set/Range/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Set/Range/Types.hs @@ -0,0 +1,21 @@ +{- | +Module : Data.Set.Range.Types +Description : Types that represent ranges and range sets. +Copyright : (c) 2017 Daniel Lovasko +License : BSD2 + +Maintainer : Daniel Lovasko +Stability : stable +Portability : portable +-} + +module Data.Set.Range.Types +( Range +, RangeSet +) where + +-- | A simple range, denoted by the low and high boundaries. +type Range a = (a,a) + +-- | A set of ranges +type RangeSet a = [Range a] diff --git a/test/Prop.hs b/test/Prop.hs new file mode 100644 --- /dev/null +++ b/test/Prop.hs @@ -0,0 +1,189 @@ +import Data.List +import Data.Word +import Safe +import System.Environment +import System.Exit +import Test.QuickCheck +import Test.QuickCheck.Test + +import qualified Data.Set.Range as R + + +-- | Test the empty set checking. +nullTest + :: [Word8] -- ^ points + -> Bool -- ^ result +nullTest xs = rset == set + where + rset = R.null (R.fromList xs) + set = null xs + +-- | Test the number of stored points in a set. +sizeTest + :: [Word8] -- ^ points + -> Bool -- ^ result +sizeTest xs = rset == set + where + rset = (R.size . R.fromList) xs :: Integer + set = (genericLength . nub) xs :: Integer + +-- | Test the conversion from and to ascending lists. +ascListTest + :: [Word8] -- ^ points + -> Bool -- ^ result +ascListTest xs = R.fromList xs == (R.fromAscList . sort) xs + +-- | Test the conversion from and to descending lists. +descListTest + :: [Word8] -- ^ points + -> Bool -- ^ result +descListTest xs = R.fromList xs == (R.fromDescList . sortBy (flip compare)) xs + +-- | Test the conversion from and to lists. +listTest + :: [Word8] -- ^ points + -> Bool -- ^ result +listTest xs = (sort . nub) xs == (R.toList . R.fromList) xs + +-- | Test adding new points to the range set. +insertPointTest + :: [Word8] -- ^ points + -> Word8 -- ^ point + -> Bool -- ^ result +insertPointTest xs y = rset == set + where + rset = R.toList $ R.insertPoint y (R.fromList xs) + set = sort $ nub (y:xs) + +-- | Test adding a new range into the range set. +insertRangeTest + :: [Word8] -- ^ points + -> (Word8,Word8) -- ^ range + -> Bool -- ^ result +insertRangeTest xs (a,b) = rset == set + where + lo = min a b + hi = max a b + rset = R.toList $ R.insertRange (lo,hi) (R.fromList xs) + set = sort $ nub ([lo .. hi] ++ xs) + +-- | Test removing a single point from the range set. +removePointTest + :: [Word8] -- ^ points + -> Word8 -- ^ point to remove + -> Bool -- ^ result +removePointTest xs y = rset == set + where + rset = R.toList $ R.removePoint y (R.fromList xs) + set = sort $ nub $ filter (/= y) xs + +-- | Test removing a range from the range set. +removeRangeTest + :: [Word8] -- ^ points + -> (Word8,Word8) -- ^ range + -> Bool -- ^ result +removeRangeTest xs (a,b) = rset == set + where + lo = min a b + hi = max a b + rset = R.toList $ R.removeRange (lo,hi) (R.fromList xs) + set = sort $ nub $ filter (not . flip elem [lo .. hi]) xs + +-- | Test the range set membership. +queryPointTest + :: [Word8] -- ^ points + -> Word8 -- ^ point + -> Bool -- ^ result +queryPointTest xs y = rset == set + where + rset = R.queryPoint y (R.fromList xs) + set = elem y xs + +-- | Test the range set membership. +queryRangeTest + :: [Word8] -- ^ points + -> (Word8,Word8) -- ^ range + -> Bool -- ^ result +queryRangeTest xs (a,b) = rset == set + where + lo = min a b + hi = max a b + rset = R.queryRange (lo,hi) (R.fromList xs) + set = all (flip elem xs) [lo .. hi] + +-- | Test the diffence of one set from another. +differenceTest + :: [Word8] -- ^ points + -> [Word8] -- ^ points + -> Bool -- ^ result +differenceTest xs ys = rset == set + where + rset = R.toList $ R.difference (R.fromList xs) (R.fromList ys) + set = sort $ nub $ filter (not . flip elem ys) xs + +-- | Test the intersection of two sets. +intersectTest + :: [Word8] -- ^ points + -> [Word8] -- ^ points + -> Bool -- ^ result +intersectTest xs ys = rset == set + where + rset = R.toList $ R.intersect (R.fromList xs) (R.fromList ys) + set = sort $ nub $ intersect xs ys + +-- | Test the union of two sets. +unionTest + :: [Word8] -- ^ points + -> [Word8] -- ^ points + -> Bool -- ^ result +unionTest xs ys = rset == set + where + rset = R.toList $ R.union (R.fromList xs) (R.fromList ys) + set = sort $ nub $ union xs ys + +-- | Print a name of the property test and execute the QuickCheck +-- algorithm. +runTest + :: Args -- ^ property test settings + -> (String, Property) -- ^ name & test + -> IO Result -- ^ result +runTest args (name, prop) = do + result <- quickCheckWithResult args prop + putStr $ unwords [name, output result] + return result + +-- | List of property tests to run. +tests + :: [(String,Property)] -- ^ name & test function +tests = [ + ("null ", property nullTest) + , ("size ", property sizeTest) + , ("ascList ", property ascListTest) + , ("descList ", property descListTest) + , ("list ", property listTest) + , ("insertPoint", property insertPointTest) + , ("insertRange", property insertRangeTest) + , ("removePoint", property removePointTest) + , ("removeRange", property removeRangeTest) + , ("queryPoint ", property queryPointTest) + , ("queryRange ", property queryRangeTest) + , ("difference ", property differenceTest) + , ("intersect ", property intersectTest) + , ("union ", property unionTest) ] + +-- | Parse command-line options into test arguments. In case invalid or +-- no arguments were provided, the test fallbacks into a default value. +parseArguments + :: [String] -- ^ command-line arguments + -> Args -- ^ test settings +parseArguments [] = stdArgs { maxSuccess=20000, chatty=False } +parseArguments (x:_) = stdArgs { maxSuccess=readDef 20000 x, chatty=False } + +-- | Evaluate test results and set appropriate process exit code. +main + :: IO () +main = do + putStrLn "\nRunning property tests:" + args <- getArgs + results <- mapM (runTest $ parseArguments args) tests + if all isSuccess results then exitSuccess else exitFailure