Ranged-sets-0.3.0/0000755000000000000000000000000011500021001012030 5ustar0000000000000000Ranged-sets-0.3.0/Ranged-sets.cabal0000644000000000000000000000247211500021001015175 0ustar0000000000000000name: Ranged-sets version: 0.3.0 cabal-version: -any build-type: Simple license: BSD3 license-file: LICENSE.txt copyright: Paul Johnson, 2005, 2006, 2007, 2008 maintainer: paul@cogito.org.uk build-depends: HUnit -any, QuickCheck >=2, base >=4 && <5 stability: beta homepage: http://code.haskell.org/ranged-sets package-url: bug-reports: synopsis: Ranged sets for Haskell description: A ranged set is an ordered list of ranges. This allows sets such as all reals x such that: . > (0.25 < x <= 0.75 or 1.4 <= x < 2.3 or 4.5 < x) . Alternatively you can have all strings s such that: . > ("F" <= s < "G") category: Data author: Paul Johnson tested-with: data-files: data-dir: "" extra-source-files: CHANGES.txt INSTALL.txt README.txt TODO.txt tests/Main.hs tests/Makefile extra-tmp-files: exposed-modules: Data.Ranged Data.Ranged.Ranges Data.Ranged.RangedSet Data.Ranged.Boundaries exposed: True buildable: True build-tools: cpp-options: cc-options: ld-options: pkgconfig-depends: frameworks: c-sources: extensions: extra-libraries: extra-lib-dirs: includes: install-includes: include-dirs: hs-source-dirs: . other-modules: ghc-prof-options: ghc-shared-options: ghc-options: -Wall hugs-options: nhc98-options: jhc-options:Ranged-sets-0.3.0/TODO.txt0000644000000000000000000000072211500021001013337 0ustar0000000000000000Things to do: * Test with yhc. * Define ranges of times and dates. The set of all Mondays, for instance, or the set of all second weeks in the month. Any such functions would have to take a start date because the only alternative is to start with the epoch, and that would not be efficient. The existing date-time functions look a bit clunky for this job, but the proposals of Ashley Yakeley at http://semantic.org/TimeLib/ look more suitable. Ranged-sets-0.3.0/README.txt0000644000000000000000000001210111500021001013521 0ustar0000000000000000Ranged Sets for Haskell ======================= Ranged sets allow programming with sets of values that are described by a list of ranges. A value is a member of the set if it lies within one of the ranges. The ranges in a set are ordered and non-overlapping, so the standard set operations can be implemented by merge algorithms in O(n) time. License ------- Currently the Ranged Set library is under the BSD 3 license. This is a very permissive license. I am hoping that Ranged Sets will eventually become part of the Base library, and at that point the implementation will have to be issued under the same license as the rest of the library (which in practice probably means different licenses for different compiler versions). As I understand it the BSD 3 license will allow this without me having to get either assignment of copyright or explicit permission from everyone who submits contributions. Boundaries ---------- Module Data.Ranged.Boundaries defines the Boundary type. A boundary divides an ordered type into values above and below the boundary. No value can ever sit on a boundary. Two boundaries are equal if they divide the values at the same point. This definition of equality causes an implementation problem because some types are "discrete". For instance there is no value between the characters 'a' and 'b', or between the integers 3 and 4. However there are values between 3.0 and 4.0. Similarly for strings, there are values between "a" and "b" such as "aa", "ab", and so on. This is important because "BoundaryAbove 3" is equal to "BoundaryBelow 4". 3 is below both boundaries, and 4 is above both. Hence they divide the integers at the same place. But on the other hand "BoundaryAbove 3.0" and "BoundaryBelow 4.0" are not equal because 3.5 is above the first and below the second. To solve this the DiscreteOrdered class is defined, which provides a function "adjacent". Two values x1 and x3 are adjacent if x1 < x3 and there does not exist an x2 such that x1 < x2 < x3. This provides the distinction necessary for boundary equality to be defined for all ordered types. The ordered types from the prelude are instances of DiscreteOrdered, and others can be added by defining "adjacent". The functions "enumAdjacent" and "boundedAdjacent" are provided for instances of Enum and Bounded. Lists and tuples of DiscreteOrdered types are also instances of DiscreteOrdered. This approach was suggested by Ben Rudiak-Gould on comp.lang.functional. In theory the Float and Double types should be treated as enumerated because they are held in fixed-length data fields, and hence must have pairs of values that are adjacent. However they are treated as continuous here for two reasons: * The Float and Double types are practical approximations to Real numbers, which are continuous. Hence it makes sense for Float and Double to pretend to share this property. * There is no standard way to determine the adjacency of Float and Double values in Haskell. "succ 3.0" returns 4.0, which is not appropriate here. Ranges ------ Module Data.Ranged.Ranges defines the Range type. A range has a lower and an upper Boundary. Set-like operations are defined on ranges, but they return variable numbers of results, and hence return either Maybe Range or [Range]. RangedSet --------- Module Data.Ranged.RangedSet defines the RSet type. This is the actual ranged set type. It is constructed from a list of ranges. There are two functions to do this: * makeRangedSet takes a finite list of ranges that may overlap or be out of order. It sorts them and merges overlapping ranges using the normaliseRangeList function. * unsafeRangedSet takes a list of ranges that must be in order and not overlapping. The behaviour of the resulting set is not defined if this precondition is not met. In theory the standard QuickCheck generator for RSet could generate an arbitrary list of ranges and then normalise them, but in practice this tends to produce a very small number of ranges because of the high probability of overlaps. So instead an arbitrary list of boundaries is generated and these are then sorted and paired off into non-overlapping ranges. Infinite Sets ------------- In theory, thanks to lazy evaluation ranged sets can handle infinite lists of ranges. These are known as "infinite sets". Note that this is not the same as a set with a final upper bound of "AboveAll". Unfortunately there is no simple way to guarantee that computations on infinite sets will terminate. So infinite sets are not supported. QuickCheck and Tests -------------------- All the types in the Ranged Set library are instances of Arbitrary from the QuickCheck library, and the source code includes a number of important properties for Ranges and RSets defined using QuickCheck. These can be treated as a formal specification of the properties of these types. The tests can be run by going into the "tests" directory and saying "make all". A coverage report is generated, and detailed HTML coverage will be found in "tests/Report". "make clean" to delete all the generated files. Ranged-sets-0.3.0/Setup.hs0000644000000000000000000000010211500021001013455 0ustar0000000000000000 module Main where import Distribution.Simple main = defaultMainRanged-sets-0.3.0/CHANGES.txt0000644000000000000000000000256611500021001013652 0ustar0000000000000000Version 0.0.2 ------------- Fixed the infinite loop with infinite sets, at least as far as possible. Added lots more QuickCheck properties. Added subset predicates. Added infix operators. Version 0.0.3 ------------- Removed support for infinite sets. They sometimes still work, but generally are more trouble than they are worth. There is no simple set of rules for client applications to guarantee termination. Replaced the "deriving" clause for the Range type with instance declarations. Empty ranges created with different bounds will now test as equal. All empty ranges now compare as less than all non-empty ranges. "show" returns a string such as "3.5 < x <= 4.6", or "x < 23". Removed "maybeRange". Changed "rangeIntersection" to return a "Range" instead of a "Maybe Range". If the intersection is empty then it returns an empty range instead of Nothing. Renamed "rangeEmpty" to "rangeIsEmpty" for consistency with "rSetIsEmpty" Added "emptyRange" and "fullRange" Version 0.0.4 ------------- Added Monoid instances and singleton ranges, courtesy of Jean-Philippe Bernardy. Version 0.2.0 ------------- Reorganised and extended tests. Added "rangeIsFull" predicate. Version 0.2.1 ------------- Require QuickCheck < 2. Version 0.3.0 ------------- Require QuickCheck >= 2.4. This changes the API for the Arbitrary and CoArbitrary instances, so it gets a version number bump. Ranged-sets-0.3.0/LICENSE.txt0000644000000000000000000000302711500021001013655 0ustar0000000000000000Copyright (c) 2005, Paul Johnson 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. * Neither the name of the Ranged Sets project nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT OWNER 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.Ranged-sets-0.3.0/INSTALL.txt0000644000000000000000000000046011500021001013677 0ustar0000000000000000As user, from within the project directory: runghc Setup.hs configure runghc Setup.hs build As root or administrator: runghc Setup.hs install If you have Haddock then generate the documentation with: runghc Setup.hs haddock If you use Hugs then type "runhugs" instead of "runghc".Ranged-sets-0.3.0/Data/0000755000000000000000000000000011500021001012701 5ustar0000000000000000Ranged-sets-0.3.0/Data/Ranged.hs0000644000000000000000000000032311500021001014433 0ustar0000000000000000module Data.Ranged ( module Data.Ranged.Boundaries, module Data.Ranged.Ranges, module Data.Ranged.RangedSet ) where import Data.Ranged.Boundaries import Data.Ranged.Ranges import Data.Ranged.RangedSet Ranged-sets-0.3.0/Data/Ranged/0000755000000000000000000000000011500021001014101 5ustar0000000000000000Ranged-sets-0.3.0/Data/Ranged/Ranges.hs0000644000000000000000000003010011500021001015646 0ustar0000000000000000----------------------------------------------------------------------------- -- -- Module : Data.Ranged.Ranges -- Copyright : (c) Paul Johnson 2006 -- License : BSD-style -- Maintainer : paul@cogito.org.uk -- Stability : experimental -- Portability : portable -- ----------------------------------------------------------------------------- -- | A range has an upper and lower boundary. module Data.Ranged.Ranges ( -- ** Construction Range (..), emptyRange, fullRange, -- ** Predicates rangeIsEmpty, rangeIsFull, rangeOverlap, rangeEncloses, rangeSingletonValue, -- ** Membership rangeHas, rangeListHas, -- ** Set Operations singletonRange, rangeIntersection, rangeUnion, rangeDifference, -- ** QuickCheck properties prop_unionRange, prop_unionRangeLength, prop_intersectionRange, prop_differenceRange, prop_intersectionOverlap, prop_enclosureUnion, prop_singletonRangeHas, prop_singletonRangeHasOnly, prop_singletonRangeConverse, prop_emptyNonSingleton, prop_fullNonSingleton, prop_nonSingleton, prop_intSingleton ) where import Control.Monad import Data.Ranged.Boundaries import Data.Maybe import Test.QuickCheck -- | A Range has upper and lower boundaries. data Ord v => Range v = Range {rangeLower, rangeUpper :: Boundary v} instance (DiscreteOrdered a) => Eq (Range a) where r1 == r2 = (rangeIsEmpty r1 && rangeIsEmpty r2) || (rangeLower r1 == rangeLower r2 && rangeUpper r1 == rangeUpper r2) instance (DiscreteOrdered a) => Ord (Range a) where compare r1 r2 | r1 == r2 = EQ | rangeIsEmpty r1 = LT | rangeIsEmpty r2 = GT | otherwise = compare (rangeLower r1, rangeUpper r1) (rangeLower r2, rangeUpper r2) instance (Show a, DiscreteOrdered a) => Show (Range a) where show r | rangeIsEmpty r = "Empty" | rangeIsFull r = "All x" | otherwise = case rangeSingletonValue r of Just v -> "x == " ++ show v Nothing -> lowerBound ++ "x" ++ upperBound where lowerBound = case rangeLower r of BoundaryBelowAll -> "" BoundaryBelow v -> show v ++ " <= " BoundaryAbove v -> show v ++ " < " BoundaryAboveAll -> error "show Range: lower bound is BoundaryAboveAll" upperBound = case rangeUpper r of BoundaryBelowAll -> error "show Range: upper bound is BoundaryBelowAll" BoundaryBelow v -> " < " ++ show v BoundaryAbove v -> " <= " ++ show v BoundaryAboveAll -> "" -- | True if the value is within the range. rangeHas :: Ord v => Range v -> v -> Bool rangeHas (Range b1 b2) v = (v />/ b1) && not (v />/ b2) -- | True if the value is within one of the ranges. rangeListHas :: Ord v => [Range v] -> v -> Bool rangeListHas ls v = or $ map (\r -> rangeHas r v) ls -- | The empty range emptyRange :: DiscreteOrdered v => Range v emptyRange = Range BoundaryAboveAll BoundaryBelowAll -- | The full range. All values are within it. fullRange :: DiscreteOrdered v => Range v fullRange = Range BoundaryBelowAll BoundaryAboveAll -- | A range containing a single value singletonRange :: DiscreteOrdered v => v -> Range v singletonRange v = Range (BoundaryBelow v) (BoundaryAbove v) -- | If the range is a singleton, returns @Just@ the value. Otherwise returns -- @Nothing@. -- -- Known bug: This always returns @Nothing@ for ranges including -- @BoundaryBelowAll@ or @BoundaryAboveAll@. For bounded types this can be -- incorrect. For instance, the following range only contains one value: -- -- > Range (BoundaryBelow maxBound) BoundaryAboveAll rangeSingletonValue :: DiscreteOrdered v => Range v -> Maybe v rangeSingletonValue (Range (BoundaryBelow v1) (BoundaryBelow v2)) | adjacent v1 v2 = Just v1 | otherwise = Nothing rangeSingletonValue (Range (BoundaryBelow v1) (BoundaryAbove v2)) | v1 == v2 = Just v1 | otherwise = Nothing rangeSingletonValue (Range (BoundaryAbove v1) (BoundaryBelow v2)) = do v2' <- adjacentBelow v2 v2'' <- adjacentBelow v2' if v1 == v2'' then return v2' else Nothing rangeSingletonValue (Range (BoundaryAbove v1) (BoundaryAbove v2)) | adjacent v1 v2 = Just v2 | otherwise = Nothing rangeSingletonValue (Range _ _) = Nothing -- | A range is empty unless its upper boundary is greater than its lower -- boundary. rangeIsEmpty :: DiscreteOrdered v => Range v -> Bool rangeIsEmpty (Range lower upper) = upper <= lower -- | A range is full if it contains every possible value. rangeIsFull :: DiscreteOrdered v => Range v -> Bool rangeIsFull = (== fullRange) -- | Two ranges overlap if their intersection is non-empty. rangeOverlap :: DiscreteOrdered v => Range v -> Range v -> Bool rangeOverlap r1 r2 = not (rangeIsEmpty r1) && not (rangeIsEmpty r2) && not (rangeUpper r1 <= rangeLower r2 || rangeUpper r2 <= rangeLower r1) -- | The first range encloses the second if every value in the second range is -- also within the first range. If the second range is empty then this is -- always true. rangeEncloses :: DiscreteOrdered v => Range v -> Range v -> Bool rangeEncloses r1 r2 = (rangeLower r1 <= rangeLower r2 && rangeUpper r2 <= rangeUpper r1) || rangeIsEmpty r2 -- | Intersection of two ranges, if any. rangeIntersection :: DiscreteOrdered v => Range v -> Range v -> Range v rangeIntersection r1@(Range lower1 upper1) r2@(Range lower2 upper2) | rangeIsEmpty r1 || rangeIsEmpty r2 = emptyRange | otherwise = Range (max lower1 lower2) (min upper1 upper2) -- | Union of two ranges. Returns one or two results. -- -- If there are two results then they are guaranteed to have a non-empty -- gap in between, but may not be in ascending order. rangeUnion :: DiscreteOrdered v => Range v -> Range v -> [Range v] rangeUnion r1@(Range lower1 upper1) r2@(Range lower2 upper2) | rangeIsEmpty r1 = [r2] | rangeIsEmpty r2 = [r1] | otherwise = if touching then [Range lower upper] else [r1, r2] where touching = (max lower1 lower2) <= (min upper1 upper2) lower = min lower1 lower2 upper = max upper1 upper2 -- | @range1@ minus @range2@. Returns zero, one or two results. Multiple -- results are guaranteed to have non-empty gaps in between, but may not be in -- ascending order. rangeDifference :: DiscreteOrdered v => Range v -> Range v -> [Range v] rangeDifference r1@(Range lower1 upper1) (Range lower2 upper2) = -- There are six possibilities -- 1: r2 completely less than r1 -- 2: r2 overlaps bottom of r1 -- 3: r2 encloses r1 -- 4: r1 encloses r2 -- 5: r2 overlaps top of r1 -- 6: r2 completely greater than r1 if intersects then -- Cases 2,3,4,5 filter (not . rangeIsEmpty) [Range lower1 lower2, Range upper2 upper1] else -- Cases 1, 6 [r1] where intersects = (max lower1 lower2) < (min upper1 upper2) -- QuickCheck generators instance (Arbitrary v, DiscreteOrdered v, Show v) => Arbitrary (Range v) where arbitrary = frequency [ (17, do -- Ordinary range b1 <- arbitrary b2 <- arbitrary if b1 < b2 then return $ Range b1 b2 else return $ Range b2 b1 ), (1, do -- Singleton range v <- arbitrary return $ singletonRange v ), (1, return emptyRange), (1, return fullRange) ] instance (CoArbitrary v, DiscreteOrdered v, Show v) => CoArbitrary (Range v) where coarbitrary (Range lower upper) = variant (0 :: Int) . coarbitrary lower . coarbitrary upper -- QuickCheck Properties -- | The union of two ranges has a value iff either range has it. -- -- > prop_unionRange r1 r2 n = -- > (r1 `rangeHas` n || r2 `rangeHas` n) -- > == (r1 `rangeUnion` r2) `rangeListHas` n prop_unionRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool prop_unionRange r1 r2 n = (r1 `rangeHas` n || r2 `rangeHas` n) == (r1 `rangeUnion` r2) `rangeListHas` n -- | The union of two ranges always contains one or two ranges. -- -- > prop_unionRangeLength r1 r2 = (n == 1) || (n == 2) -- > where n = length $ rangeUnion r1 r2 prop_unionRangeLength :: (DiscreteOrdered a) => Range a -> Range a -> Bool prop_unionRangeLength r1 r2 = (n == 1) || (n == 2) where n = length $ rangeUnion r1 r2 -- | The intersection of two ranges has a value iff both ranges have it. -- -- > prop_intersectionRange r1 r2 n = -- > (r1 `rangeHas` n && r2 `rangeHas` n) -- > == (r1 `rangeIntersection` r2) `rangeHas` n prop_intersectionRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool prop_intersectionRange r1 r2 n = (r1 `rangeHas` n && r2 `rangeHas` n) == (r1 `rangeIntersection` r2) `rangeHas` n -- | The difference of two ranges has a value iff the first range has it and -- the second does not. -- -- > prop_differenceRange r1 r2 n = -- > (r1 `rangeHas` n && not (r2 `rangeHas` n)) -- > == (r1 `rangeDifference` r2) `rangeListHas` n prop_differenceRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool prop_differenceRange r1 r2 n = (r1 `rangeHas` n && not (r2 `rangeHas` n)) == (r1 `rangeDifference` r2) `rangeListHas` n -- | Iff two ranges overlap then their intersection is non-empty. -- -- > prop_intersectionOverlap r1 r2 = -- > (rangeIsEmpty $ rangeIntersection r1 r2) == (rangeOverlap r1 r2) prop_intersectionOverlap :: (DiscreteOrdered a) => Range a -> Range a -> Bool prop_intersectionOverlap r1 r2 = (rangeIsEmpty $ rangeIntersection r1 r2) == not (rangeOverlap r1 r2) -- | Range enclosure makes union an identity function. -- -- > prop_enclosureUnion r1 r2 = -- > rangeEncloses r1 r2 == (rangeUnion r1 r2 == [r1]) prop_enclosureUnion :: (DiscreteOrdered a) => Range a -> Range a -> Bool prop_enclosureUnion r1 r2 = rangeEncloses r1 r2 == (rangeUnion r1 r2 == [r1]) -- | Range Singleton has its member. -- -- > prop_singletonRangeHas v = singletonRange v `rangeHas` v prop_singletonRangeHas :: (DiscreteOrdered a) => a -> Bool prop_singletonRangeHas v = singletonRange v `rangeHas` v -- | Range Singleton has only its member. -- -- > prop_singletonHasOnly v1 v2 = -- > (v1 == v2) == (singletonRange v1 `rangeHas` v2) prop_singletonRangeHasOnly :: (DiscreteOrdered a) => a -> a -> Bool prop_singletonRangeHasOnly v1 v2 = (v1 == v2) == (singletonRange v1 `rangeHas` v2) -- | A singleton range can have its value extracted. -- -- > prop_singletonRangeConverse v = -- > rangeSingletonValue (singletonRange v) == Just v prop_singletonRangeConverse:: (DiscreteOrdered a) => a -> Bool prop_singletonRangeConverse v = rangeSingletonValue (singletonRange v) == Just v -- | The empty range is not a singleton. -- -- > prop_emptyNonSingleton = rangeSingletonValue emptyRange == Nothing prop_emptyNonSingleton :: Bool prop_emptyNonSingleton = rangeSingletonValue (emptyRange :: Range Int) == Nothing -- | The full range is not a singleton. -- -- > prop_fullNonSingleton = rangeSingletonValue fullRange == Nothing prop_fullNonSingleton :: Bool prop_fullNonSingleton = rangeSingletonValue (fullRange :: Range Int) == Nothing -- | For real x and y, @x < y@ implies that any range between them is a -- non-singleton. prop_nonSingleton :: Double -> Double -> Property prop_nonSingleton x y = (x < y) ==> null $ mapMaybe rangeSingletonValue rs where rs = [ Range (BoundaryBelow x) (BoundaryBelow y), Range (BoundaryAbove x) (BoundaryBelow y), Range (BoundaryBelow x) (BoundaryAbove y), Range (BoundaryAbove x) (BoundaryAbove y)] -- | For all integers x and y, any range formed from boundaries on either side -- of x and y is a singleton iff it contains exactly one integer. prop_intSingleton :: Integer -> Integer -> Property prop_intSingleton x y = forAll (rangeAround x y) $ \r -> case filter (rangeHas r) [x-1 .. y+1] of [v] -> rangeSingletonValue r == Just v _ -> rangeSingletonValue r == Nothing where rangeAround v1 v2 = return Range `ap` genBound v1 `ap` genBound v2 genBound v = elements [BoundaryAbove v, BoundaryBelow v] Ranged-sets-0.3.0/Data/Ranged/RangedSet.hs0000644000000000000000000004012511500021001016313 0ustar0000000000000000module Data.Ranged.RangedSet ( -- ** Ranged Set Type RSet, rSetRanges, -- ** Ranged Set construction functions and their preconditions makeRangedSet, unsafeRangedSet, validRangeList, normaliseRangeList, rSingleton, rSetUnfold, -- ** Predicates rSetIsEmpty, rSetIsFull, (-?-), rSetHas, (-<=-), rSetIsSubset, (-<-), rSetIsSubsetStrict, -- ** Set Operations (-\/-), rSetUnion, (-/\-), rSetIntersection, (-!-), rSetDifference, rSetNegation, -- ** Useful Sets rSetEmpty, rSetFull, -- ** QuickCheck Properties -- *** Construction prop_validNormalised, prop_has, prop_unfold, -- *** Basic Operations prop_union, prop_intersection, prop_difference, prop_negation, prop_not_empty, -- *** Some Identities and Inequalities -- $ConstructionProperties -- $BasicOperationProperties -- $SomeIdentitiesAndInequalities prop_empty, prop_full, prop_empty_intersection, prop_full_union, prop_union_superset, prop_intersection_subset, prop_diff_intersect, prop_subset, prop_strict_subset, prop_union_strict_superset, prop_intersection_commutes, prop_union_commutes, prop_intersection_associates, prop_union_associates, prop_de_morgan_intersection, prop_de_morgan_union, ) where import Data.Ranged.Boundaries import Data.Ranged.Ranges import Data.Monoid import Data.List import Test.QuickCheck infixl 7 -/\- infixl 6 -\/-, -!- infixl 5 -<=-, -<-, -?- -- | An RSet (for Ranged Set) is a list of ranges. The ranges must be sorted -- and not overlap. newtype DiscreteOrdered v => RSet v = RSet {rSetRanges :: [Range v]} deriving (Eq, Show) instance DiscreteOrdered a => Monoid (RSet a) where mappend = rSetUnion mempty = rSetEmpty -- | Determine if the ranges in the list are both in order and non-overlapping. -- If so then they are suitable input for the unsafeRangedSet function. validRangeList :: DiscreteOrdered v => [Range v] -> Bool validRangeList [] = True validRangeList [Range lower upper] = lower <= upper validRangeList rs = and $ zipWith okAdjacent rs (tail rs) where okAdjacent (Range lower1 upper1) (Range lower2 upper2) = lower1 <= upper1 && upper1 <= lower2 && lower2 <= upper2 -- | Rearrange and merge the ranges in the list so that they are in order and -- non-overlapping. normaliseRangeList :: DiscreteOrdered v => [Range v] -> [Range v] normaliseRangeList = normalise . sort . filter (not . rangeIsEmpty) -- Private routine: normalise a range list that is known to be already sorted. -- This precondition is not checked. normalise :: DiscreteOrdered v => [Range v] -> [Range v] normalise (r1:r2:rs) = if overlap r1 r2 then normalise $ Range (rangeLower r1) (max (rangeUpper r1) (rangeUpper r2)) : rs else r1 : (normalise $ r2 : rs) where overlap (Range _ upper1) (Range lower2 _) = upper1 >= lower2 normalise rs = rs -- | Create a new Ranged Set from a list of ranges. The list may contain -- ranges that overlap or are not in ascending order. makeRangedSet :: DiscreteOrdered v => [Range v] -> RSet v makeRangedSet = RSet . normaliseRangeList -- | Create a new Ranged Set from a list of ranges. @validRangeList ranges@ -- must return @True@. This precondition is not checked. unsafeRangedSet :: DiscreteOrdered v => [Range v] -> RSet v unsafeRangedSet = RSet -- | Create a Ranged Set from a single element. rSingleton :: DiscreteOrdered v => v -> RSet v rSingleton v = unsafeRangedSet [singletonRange v] -- | True if the set has no members. rSetIsEmpty :: DiscreteOrdered v => RSet v -> Bool rSetIsEmpty = null . rSetRanges -- | True if the negation of the set has no members. rSetIsFull :: DiscreteOrdered v => RSet v -> Bool rSetIsFull = rSetIsEmpty . rSetNegation -- | True if the value is within the ranged set. Infix precedence is left 5. rSetHas, (-?-) :: DiscreteOrdered v => RSet v -> v -> Bool rSetHas (RSet ls) value = rSetHas1 ls where rSetHas1 [] = False rSetHas1 (r:rs) | value />/ rangeLower r = rangeHas r value || rSetHas1 rs | otherwise = False (-?-) = rSetHas -- | True if the first argument is a subset of the second argument, or is -- equal. -- -- Infix precedence is left 5. rSetIsSubset, (-<=-) :: DiscreteOrdered v => RSet v -> RSet v -> Bool rSetIsSubset rs1 rs2 = rSetIsEmpty (rs1 -!- rs2) (-<=-) = rSetIsSubset -- | True if the first argument is a strict subset of the second argument. -- -- Infix precedence is left 5. rSetIsSubsetStrict, (-<-) :: DiscreteOrdered v => RSet v -> RSet v -> Bool rSetIsSubsetStrict rs1 rs2 = rSetIsEmpty (rs1 -!- rs2) && not (rSetIsEmpty (rs2 -!- rs1)) (-<-) = rSetIsSubsetStrict -- | Set union for ranged sets. Infix precedence is left 6. rSetUnion, (-\/-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v -- Implementation note: rSetUnion merges the two lists into a single -- sorted list and then calls normalise to combine overlapping ranges. rSetUnion (RSet ls1) (RSet ls2) = RSet $ normalise $ merge ls1 ls2 where merge ms1 [] = ms1 merge [] ms2 = ms2 merge ms1@(h1:t1) ms2@(h2:t2) = if h1 < h2 then h1 : merge t1 ms2 else h2 : merge ms1 t2 (-\/-) = rSetUnion -- | Set intersection for ranged sets. Infix precedence is left 7. rSetIntersection, (-/\-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v rSetIntersection (RSet ls1) (RSet ls2) = RSet $ filter (not . rangeIsEmpty) $ merge ls1 ls2 where merge ms1@(h1:t1) ms2@(h2:t2) = rangeIntersection h1 h2 : if rangeUpper h1 < rangeUpper h2 then merge t1 ms2 else merge ms1 t2 merge _ _ = [] (-/\-) = rSetIntersection -- | Set difference. Infix precedence is left 6. rSetDifference, (-!-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v rSetDifference rs1 rs2 = rs1 -/\- (rSetNegation rs2) (-!-) = rSetDifference -- | Set negation. rSetNegation :: DiscreteOrdered a => RSet a -> RSet a rSetNegation set = RSet $ ranges1 $ setBounds1 where ranges1 (b1:b2:bs) = Range b1 b2 : ranges1 bs ranges1 [BoundaryAboveAll] = [] ranges1 [b] = [Range b BoundaryAboveAll] ranges1 _ = [] setBounds1 = case setBounds of (BoundaryBelowAll : bs) -> bs _ -> BoundaryBelowAll : setBounds setBounds = bounds $ rSetRanges set bounds (r:rs) = rangeLower r : rangeUpper r : bounds rs bounds _ = [] -- | The empty set. rSetEmpty :: DiscreteOrdered a => RSet a rSetEmpty = RSet [] -- | The set that contains everything. rSetFull :: DiscreteOrdered a => RSet a rSetFull = RSet [Range BoundaryBelowAll BoundaryAboveAll] -- | Construct a range set. rSetUnfold :: DiscreteOrdered a => Boundary a -- ^ A first lower boundary. -> (Boundary a -> Boundary a) -- ^ A function from a lower boundary to an upper boundary, which must -- return a result greater than the argument (not checked). -> (Boundary a -> Maybe (Boundary a)) -- ^ A function from a lower boundary to @Maybe@ the successor lower -- boundary, which must return a result greater than the argument -- (not checked). If ranges overlap then they will be merged. -> RSet a rSetUnfold bound upperFunc succFunc = RSet $ normalise $ ranges1 bound where ranges1 b = Range b (upperFunc b) : case succFunc b of Just b2 -> ranges1 b2 Nothing -> [] -- QuickCheck Generators instance (Arbitrary v, DiscreteOrdered v, Show v) => Arbitrary (RSet v) where arbitrary = frequency [ (1, return rSetEmpty), (1, return rSetFull), (18, do ls <- arbitrary return $ makeRangedSet $ rangeList $ sort ls )] where -- Arbitrary lists of ranges don't give many interesting sets after -- normalisation. So instead generate a sorted list of boundaries -- and pair them off. Odd boundaries are dropped. rangeList (b1:b2:bs) = Range b1 b2 : rangeList bs rangeList _ = [] instance (CoArbitrary v, DiscreteOrdered v, Show v) => CoArbitrary (RSet v) where coarbitrary (RSet ls) = variant (0 :: Int) . coarbitrary ls -- ================================================================== -- QuickCheck Properties -- ================================================================== --------------------------------------------------------------------- -- Construction properties --------------------------------------------------------------------- -- | A normalised range list is valid for unsafeRangedSet -- -- > prop_validNormalised ls = validRangeList $ normaliseRangeList ls prop_validNormalised :: (DiscreteOrdered a) => [Range a] -> Bool prop_validNormalised ls = validRangeList $ normaliseRangeList ls -- | Iff a value is in a range list then it is in a ranged set -- constructed from that list. -- -- > prop_has ls v = (ls `rangeListHas` v) == makeRangedSet ls -?- v prop_has :: (DiscreteOrdered a) => [Range a] -> a -> Bool prop_has ls v = (ls `rangeListHas` v) == makeRangedSet ls -?- v -- | Verifies the correct membership of a set containing all integers -- starting with the digit \"1\" up to 19999. -- -- > prop_unfold = (v <= 99999 && head (show v) == '1') == (initial1 -?- v) -- > where -- > initial1 = rSetUnfold (BoundaryBelow 1) addNines times10 -- > addNines (BoundaryBelow n) = BoundaryAbove $ n * 2 - 1 -- > times10 (BoundaryBelow n) = -- > if n <= 1000 then Just $ BoundaryBelow $ n * 10 else Nothing prop_unfold :: Integer -> Bool prop_unfold v = (v <= 99999 && head (show v) == '1') == (initial1 -?- v) where initial1 = rSetUnfold (BoundaryBelow 1) addNines times10 addNines (BoundaryBelow n) = BoundaryAbove $ n * 2 - 1 addNines _ = error "Can't happen" times10 (BoundaryBelow n) = if n <= 10000 then Just $ BoundaryBelow $ n * 10 else Nothing times10 _ = error "Can't happen" --------------------------------------------------------------------- -- Basic operation properties --------------------------------------------------------------------- -- | Iff a value is in either of two ranged sets then it is in the union of -- those two sets. -- -- > prop_union rs1 rs2 v = -- > (rs1 -?- v || rs2 -?- v) == ((rs1 -\/- rs2) -?- v) prop_union :: (DiscreteOrdered a ) => RSet a -> RSet a -> a -> Bool prop_union rs1 rs2 v = (rs1 -?- v || rs2 -?- v) == ((rs1 -\/- rs2) -?- v) -- | Iff a value is in both of two ranged sets then it is n the intersection -- of those two sets. -- -- > prop_intersection rs1 rs2 v = -- > (rs1 -?- v && rs2 -?- v) == ((rs1 -/\- rs2) -?- v) prop_intersection :: (DiscreteOrdered a) => RSet a -> RSet a -> a -> Bool prop_intersection rs1 rs2 v = (rs1 -?- v && rs2 -?- v) == ((rs1 -/\- rs2) -?- v) -- | Iff a value is in ranged set 1 and not in ranged set 2 then it is in the -- difference of the two. -- -- > prop_difference rs1 rs2 v = -- > (rs1 -?- v && not (rs2 -?- v)) == ((rs1 -!- rs2) -?- v) prop_difference :: (DiscreteOrdered a) => RSet a -> RSet a -> a -> Bool prop_difference rs1 rs2 v = (rs1 -?- v && not (rs2 -?- v)) == ((rs1 -!- rs2) -?- v) -- | Iff a value is not in a ranged set then it is in its negation. -- -- > prop_negation rs v = rs -?- v == not (rSetNegation rs -?- v) prop_negation :: (DiscreteOrdered a) => RSet a -> a -> Bool prop_negation rs v = rs -?- v == not (rSetNegation rs -?- v) -- | A set that contains a value is not empty -- -- > prop_not_empty rs v = (rs -?- v) ==> not (rSetIsEmpty rs) prop_not_empty :: (DiscreteOrdered a) => RSet a -> a -> Property prop_not_empty rs v = (rs -?- v) ==> not (rSetIsEmpty rs) --------------------------------------------------------------------- -- Some identities and inequalities of sets --------------------------------------------------------------------- -- | The empty set has no members. -- -- > prop_empty v = not (rSetEmpty -?- v) prop_empty :: (DiscreteOrdered a) => a -> Bool prop_empty v = not (rSetEmpty -?- v) -- | The full set has every member. -- -- > prop_full v = rSetFull -?- v prop_full :: (DiscreteOrdered a) => a -> Bool prop_full v = rSetFull -?- v -- | The intersection of a set with its negation is empty. -- -- > prop_empty_intersection rs = -- > rSetIsEmpty (rs -/\- rSetNegation rs) prop_empty_intersection :: (DiscreteOrdered a) => RSet a -> Bool prop_empty_intersection rs = rSetIsEmpty (rs -/\- rSetNegation rs) -- | The union of a set with its negation is full. -- -- > prop_full_union rs v = -- > rSetIsFull (rs -\/- rSetNegation rs) prop_full_union :: (DiscreteOrdered a) => RSet a -> Bool prop_full_union rs = rSetIsFull (rs -\/- rSetNegation rs) -- | The union of two sets is the non-strict superset of both. -- -- > prop_union_superset rs1 rs2 = -- > rs1 -<=- u && rs2 -<=- u -- > where -- > u = rs1 -\/- rs2 prop_union_superset :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_union_superset rs1 rs2 = rs1 -<=- u && rs2 -<=- u where u = rs1 -\/- rs2 -- | The intersection of two sets is the non-strict subset of both. -- -- > prop_intersection_subset rs1 rs2 = -- > i -<=- rs1 && i -<=- rs2 -- > where -- > i = rs1 -/\- rs2 prop_intersection_subset :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_intersection_subset rs1 rs2 = i -<=- rs1 && i -<=- rs2 where i = rs1 -/\- rs2 -- | The difference of two sets intersected with the subtractand is empty. -- -- > prop_diff_intersect rs1 rs2 = -- > rSetIsEmpty ((rs1 -!- rs2) -/\- rs2) prop_diff_intersect :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_diff_intersect rs1 rs2 = rSetIsEmpty ((rs1 -!- rs2) -/\- rs2) -- | A set is the non-strict subset of itself. -- -- > prop_subset rs = rs -<=- rs prop_subset :: (DiscreteOrdered a) => RSet a -> Bool prop_subset rs = rs -<=- rs -- | A set is not the strict subset of itself. -- -- > prop_strict_subset rs = not (rs -<- rs) prop_strict_subset :: (DiscreteOrdered a) => RSet a -> Bool prop_strict_subset rs = not (rs -<- rs) -- | If rs1 - rs2 is not empty then the union of rs1 and rs2 will be a strict -- superset of rs2. -- -- > prop_union_strict_superset rs1 rs2 = -- > (not $ rSetIsEmpty (rs1 -!- rs2)) -- > ==> (rs2 -<- (rs1 -\/- rs2)) prop_union_strict_superset :: (DiscreteOrdered a) => RSet a -> RSet a -> Property prop_union_strict_superset rs1 rs2 = (not $ rSetIsEmpty (rs1 -!- rs2)) ==> (rs2 -<- (rs1 -\/- rs2)) -- | Intersection commutes. -- -- > prop_intersection_commutes rs1 rs2 = (rs1 -/\- rs2) == (rs2 -/\- rs1) prop_intersection_commutes :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_intersection_commutes rs1 rs2 = (rs1 -/\- rs2) == (rs2 -/\- rs1) -- | Union commutes. -- -- > prop_union_commutes rs1 rs2 = (rs1 -\/- rs2) == (rs2 -\/- rs1) prop_union_commutes :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_union_commutes rs1 rs2 = (rs1 -\/- rs2) == (rs2 -\/- rs1) -- | Intersection associates. -- -- > prop_intersection_associates rs1 rs2 rs3 = -- > ((rs1 -/\- rs2) -/\- rs3) == (rs1 -/\- (rs2 -/\- rs3)) prop_intersection_associates :: (DiscreteOrdered a) => RSet a -> RSet a -> RSet a -> Bool prop_intersection_associates rs1 rs2 rs3 = ((rs1 -/\- rs2) -/\- rs3) == (rs1 -/\- (rs2 -/\- rs3)) -- | Union associates. -- -- > prop_union_associates rs1 rs2 rs3 = -- > ((rs1 -\/- rs2) -\/- rs3) == (rs1 -\/- (rs2 -\/- rs3)) prop_union_associates :: (DiscreteOrdered a) => RSet a -> RSet a -> RSet a -> Bool prop_union_associates rs1 rs2 rs3 = ((rs1 -\/- rs2) -\/- rs3) == (rs1 -\/- (rs2 -\/- rs3)) -- | De Morgan's Law for Intersection. -- -- > prop_de_morgan_intersection rs1 rs2 = -- > rSetNegation (rs1 -/\- rs2) == (rSetNegation rs1 -\/- rSetNegation rs2) prop_de_morgan_intersection :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_de_morgan_intersection rs1 rs2 = rSetNegation (rs1 -/\- rs2) == (rSetNegation rs1 -\/- rSetNegation rs2) -- | De Morgan's Law for Union. -- -- > prop_de_morgan_union rs1 rs2 = -- > rSetNegation (rs1 -\/- rs2) == (rSetNegation rs1 -/\- rSetNegation rs2) prop_de_morgan_union :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool prop_de_morgan_union rs1 rs2 = rSetNegation (rs1 -\/- rs2) == (rSetNegation rs1 -/\- rSetNegation rs2) Ranged-sets-0.3.0/Data/Ranged/Boundaries.hs0000644000000000000000000001617611500021001016543 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Ranged.Boundaries -- Copyright : (c) Paul Johnson 2006 -- License : BSD-style -- Maintainer : paul@cogito.org.uk -- Stability : experimental -- Portability : portable -- ----------------------------------------------------------------------------- module Data.Ranged.Boundaries ( DiscreteOrdered (..), enumAdjacent, boundedAdjacent, boundedBelow, Boundary (..), above, (/>/) ) where import Data.Ratio import Test.QuickCheck infix 4 />/ {- | Distinguish between dense and sparse ordered types. A dense type is one in which any two values @v1 < v2@ have a third value @v3@ such that @v1 < v3 < v2@. In theory the floating types are dense, although in practice they can only have finitely many values. This class treats them as dense. Tuples up to 4 members are declared as instances. Larger tuples may be added if necessary. Most values of sparse types have an @adjacentBelow@, such that, for all x: > case adjacentBelow x of > Just x1 -> adjacent x1 x > Nothing -> True The exception is for bounded types when @x == lowerBound@. For dense types @adjacentBelow@ always returns 'Nothing'. This approach was suggested by Ben Rudiak-Gould on comp.lang.functional. -} class Ord a => DiscreteOrdered a where -- | Two values @x@ and @y@ are adjacent if @x < y@ and there does not -- exist a third value between them. Always @False@ for dense types. adjacent :: a -> a -> Bool -- | The value immediately below the argument, if it can be determined. adjacentBelow :: a -> Maybe a -- Implementation note: the precise rules about unbounded enumerated vs -- bounded enumerated types are difficult to express using Haskell 98, so -- the prelude types are listed individually here. instance DiscreteOrdered Bool where adjacent = boundedAdjacent adjacentBelow = boundedBelow instance DiscreteOrdered Ordering where adjacent = boundedAdjacent adjacentBelow = boundedBelow instance DiscreteOrdered Char where adjacent = boundedAdjacent adjacentBelow = boundedBelow instance DiscreteOrdered Int where adjacent = boundedAdjacent adjacentBelow = boundedBelow instance DiscreteOrdered Integer where adjacent = enumAdjacent adjacentBelow = Just . pred instance DiscreteOrdered Double where adjacent _ _ = False adjacentBelow = const Nothing instance DiscreteOrdered Float where adjacent _ _ = False adjacentBelow = const Nothing instance (Integral a) => DiscreteOrdered (Ratio a) where adjacent _ _ = False adjacentBelow = const Nothing instance Ord a => DiscreteOrdered [a] where adjacent _ _ = False adjacentBelow = const Nothing instance (Ord a, DiscreteOrdered b) => DiscreteOrdered (a, b) where adjacent (x1, x2) (y1, y2) = (x1 == y1) && adjacent x2 y2 adjacentBelow (x1, x2) = do -- Maybe monad x2' <- adjacentBelow x2 return (x1, x2') instance (Ord a, Ord b, DiscreteOrdered c) => DiscreteOrdered (a, b, c) where adjacent (x1, x2, x3) (y1, y2, y3) = (x1 == y1) && (x2 == y2) && adjacent x3 y3 adjacentBelow (x1, x2, x3) = do -- Maybe monad x3' <- adjacentBelow x3 return (x1, x2, x3') instance (Ord a, Ord b, Ord c, DiscreteOrdered d) => DiscreteOrdered (a, b, c, d) where adjacent (x1, x2, x3, x4) (y1, y2, y3, y4) = (x1 == y1) && (x2 == y2) && (x3 == y3) && adjacent x4 y4 adjacentBelow (x1, x2, x3, x4) = do -- Maybe monad x4' <- adjacentBelow x4 return (x1, x2, x3, x4') -- | Check adjacency for sparse enumerated types (i.e. where there -- is no value between @x@ and @succ x@). enumAdjacent :: (Ord a, Enum a) => a -> a -> Bool enumAdjacent x y = (succ x == y) -- | Check adjacency, allowing for case where x = maxBound. Use as the -- definition of "adjacent" for bounded enumerated types such as Int and Char. boundedAdjacent :: (Ord a, Enum a) => a -> a -> Bool boundedAdjacent x y = if x < y then succ x == y else False -- | The usual implementation of 'adjacentBelow' for bounded enumerated types. boundedBelow :: (Eq a, Enum a, Bounded a) => a -> Maybe a boundedBelow x = if x == minBound then Nothing else Just $ pred x {- | A Boundary is a division of an ordered type into values above and below the boundary. No value can sit on a boundary. Known bug: for Bounded types * @BoundaryAbove maxBound < BoundaryAboveAll@ * @BoundaryBelow minBound > BoundaryBelowAll@ This is incorrect because there are no possible values in between the left and right sides of these inequalities. -} data Boundary a = -- | The argument is the highest value below the boundary. BoundaryAbove a | -- | The argument is the lowest value above the boundary. BoundaryBelow a | -- | The boundary above all values. BoundaryAboveAll | -- | The boundary below all values. BoundaryBelowAll deriving (Show) -- | True if the value is above the boundary, false otherwise. above :: Ord v => Boundary v -> v -> Bool above (BoundaryAbove b) v = v > b above (BoundaryBelow b) v = v >= b above BoundaryAboveAll _ = False above BoundaryBelowAll _ = True -- | Same as 'above', but with the arguments reversed for more intuitive infix -- usage. (/>/) :: Ord v => v -> Boundary v -> Bool (/>/) = flip above instance (DiscreteOrdered a) => Eq (Boundary a) where b1 == b2 = compare b1 b2 == EQ instance (DiscreteOrdered a) => Ord (Boundary a) where -- Comparison alogrithm based on brute force and ignorance: -- enumerate all combinations. compare boundary1 boundary2 = case boundary1 of BoundaryAbove b1 -> case boundary2 of BoundaryAbove b2 -> compare b1 b2 BoundaryBelow b2 -> if b1 < b2 then if adjacent b1 b2 then EQ else LT else GT BoundaryAboveAll -> LT BoundaryBelowAll -> GT BoundaryBelow b1 -> case boundary2 of BoundaryAbove b2 -> if b1 > b2 then if adjacent b2 b1 then EQ else GT else LT BoundaryBelow b2 -> compare b1 b2 BoundaryAboveAll -> LT BoundaryBelowAll -> GT BoundaryAboveAll -> case boundary2 of BoundaryAboveAll -> EQ _ -> GT BoundaryBelowAll -> case boundary2 of BoundaryBelowAll -> EQ _ -> LT -- QuickCheck Generator instance Arbitrary a => Arbitrary (Boundary a) where arbitrary = frequency [ (1, return BoundaryAboveAll), (1, return BoundaryBelowAll), (18, do v <- arbitrary oneof [return $ BoundaryAbove v, return $ BoundaryBelow v] )] instance CoArbitrary a => CoArbitrary (Boundary a) where coarbitrary BoundaryBelowAll = variant (0 :: Int) coarbitrary BoundaryAboveAll = variant (1 :: Int) coarbitrary (BoundaryBelow v) = variant (2 :: Int) . coarbitrary v coarbitrary (BoundaryAbove v) = variant (3 :: Int) . coarbitrary v Ranged-sets-0.3.0/tests/0000755000000000000000000000000011500021001013172 5ustar0000000000000000Ranged-sets-0.3.0/tests/Makefile0000644000000000000000000000043411500021001014633 0ustar0000000000000000# Tests for Ranged Sets. all: ghc --make -fhpc -i.. -odir . -hidir . -Wall Main.hs -o test-rset rm -f test-rset.tix ./test-rset hpc markup --destdir=Report test-rset hpc report test-rset clean: rm -fR Data rm -f test-rset.tix rm -f test-rset rm -f *.o *.hi rm -fR Report Ranged-sets-0.3.0/tests/Main.hs0000644000000000000000000002032211500021001014411 0ustar0000000000000000{-# OPTIONS_GHC -fglasgow-exts #-} module Main where import Data.Ranged import Test.HUnit import Test.QuickCheck conf :: Args conf = stdArgs { maxSuccess = 1000, maxDiscard = 10000 } check :: (Test.QuickCheck.Testable prop) => prop -> IO () check = quickCheckWith conf main :: IO () main = do putStrLn "QuickCheck Data.Ranged.Ranges:" putStrLn " Sparse type Integer:" putStrLn " * prop_unionRange" check $ \(r1 :: Range Integer) -> prop_unionRange r1 putStrLn " * prop_unionRangeLength" check $ \(r1 :: Range Integer) -> prop_unionRangeLength r1 putStrLn " * prop_intersectionRange" check $ \(r1 :: Range Integer) -> prop_intersectionRange r1 putStrLn " * prop_intersectionOverlap" check $ \(r1 :: Range Integer) -> prop_intersectionOverlap r1 putStrLn " * prop_enclosureUnion" check $ \(r1 :: Range Integer) -> prop_enclosureUnion r1 putStrLn " * prop_differenceRange" check $ \(r1 :: Range Integer) -> prop_differenceRange r1 putStrLn " * prop_singletonRangeHas" check $ \(v :: Integer) -> prop_singletonRangeHas v putStrLn " * prop_singletonRangeHasOnly" check $ \(v :: Integer) -> prop_singletonRangeHasOnly v putStrLn " * prop_singletonRangeConverse" check $ \(v :: Integer) -> prop_singletonRangeConverse v putStrLn " Dense type Double:" putStrLn " * prop_unionRange" check $ \(r1 :: Range Double) -> prop_unionRange r1 putStrLn " * prop_unionRangeLength" check $ \(r1 :: Range Double) -> prop_unionRangeLength r1 putStrLn " * prop_intersectionRange" check $ \(r1 :: Range Double) -> prop_intersectionRange r1 putStrLn " * prop_intersectionOverlap" check $ \(r1 :: Range Integer) -> prop_intersectionOverlap r1 putStrLn " * prop_enclosureUnion" check $ \(r1 :: Range Integer) -> prop_enclosureUnion r1 putStrLn " * prop_differenceRange" check $ \(r1 :: Range Double) -> prop_differenceRange r1 putStrLn " * prop_singletonRangeHas" check $ \(v :: Double) -> prop_singletonRangeHas v putStrLn " * prop_singletonRangeHasOnly" check $ \(v :: Double) -> prop_singletonRangeHasOnly v putStrLn " * prop_singletonRangeConverse" check $ \(v :: Double) -> prop_singletonRangeConverse v putStrLn " Type-insensitive tests:" putStrLn " * prop_emptyNonSingleton" check prop_emptyNonSingleton putStrLn " * prop_fullNonSingleton" check prop_fullNonSingleton putStrLn " * prop_nonSingleton" check prop_nonSingleton putStrLn " * prop_intSingleton" check prop_intSingleton putStrLn " Checking show for range:" _ <- runTestTT $ TestList [ TestCase $ assertEqual "Show range1" "3 <= x <= 8" $ show $ Range (BoundaryBelow (3 :: Int)) (BoundaryAbove 8), TestCase $ assertEqual "Show range2" "x < 8" $ show $ Range (BoundaryBelowAll) (BoundaryBelow (8 :: Int)), TestCase $ assertEqual "Show range3" "3 < x" $ show $ Range (BoundaryAbove (3 :: Int)) (BoundaryAboveAll), TestCase $ assertEqual "Show singleton" "x == 4" $ show $ singletonRange (4 :: Int), TestCase $ assertEqual "Show full" "All x" $ show (fullRange :: Range Int), TestCase $ assertEqual "Show empty" "Empty" $ show (emptyRange :: Range Int) ] putStrLn "QuickCheck Data.Ranged.RangedSet:" putStrLn " Sparse type Integer:" putStrLn " * prop_validNormalised" check $ \(rs :: [Range Integer]) -> prop_validNormalised rs putStrLn " * prop_has" check $ \(rs :: [Range Integer]) -> prop_has rs putStrLn " * prop_unfold" check prop_unfold putStrLn " * prop_union" check $ \(rset1 :: RSet Integer) -> prop_union rset1 putStrLn " * prop_intersection" check $ \(rset1 :: RSet Integer) -> prop_intersection rset1 putStrLn " * prop_difference" check $ \(rset1 :: RSet Integer) -> prop_difference rset1 putStrLn " * prop_negation" check $ \(rset1 :: RSet Integer) -> prop_negation rset1 putStrLn " * prop_not_empty" check $ \(rset1 :: RSet Integer) -> prop_not_empty rset1 putStrLn " * prop_empty" check $ \(v :: Integer) -> prop_empty v putStrLn " * prop_full" check $ \(v :: Integer) -> prop_full v putStrLn " * prop_empty_intersection" check $ \(rset1 :: RSet Integer) -> prop_empty_intersection rset1 putStrLn " * prop_full_union" check $ \(rset1 :: RSet Integer) -> prop_full_union rset1 putStrLn " * prop_union_superset" check $ \(rset1 :: RSet Integer) -> prop_union_superset rset1 putStrLn " * prop_intersection_subset" check $ \(rset1 :: RSet Integer) -> prop_intersection_subset rset1 putStrLn " * prop_diff_intersect" check $ \(rset1 :: RSet Integer) -> prop_diff_intersect rset1 putStrLn " * prop_subset" check $ \(rset1 :: RSet Integer) -> prop_subset rset1 putStrLn " * prop_strict_subset" check $ \(rset1 :: RSet Integer) -> prop_strict_subset rset1 putStrLn " * prop_union_strict_superset" check $ \(rset1 :: RSet Integer) -> prop_union_strict_superset rset1 putStrLn " * prop_intersection_commutes" check $ \(rset1 :: RSet Integer) -> prop_intersection_commutes rset1 putStrLn " * prop_union_commutes" check $ \(rset1 :: RSet Integer) -> prop_union_commutes rset1 putStrLn " * prop_intersection_associates" check $ \(rset1 :: RSet Integer) -> prop_intersection_associates rset1 putStrLn " * prop_union_associates" check $ \(rset1 :: RSet Integer) -> prop_union_associates rset1 putStrLn " * prop_de_morgan_intersection" check $ \(rset1 :: RSet Integer) -> prop_de_morgan_intersection rset1 putStrLn " * prop_de_morgan_union" check $ \(rset1 :: RSet Integer) -> prop_de_morgan_union rset1 putStrLn " Dense type Double:" putStrLn " * prop_validNormalised" check $ \(rs :: [Range Double]) -> prop_validNormalised rs putStrLn " * prop_has" check $ \(rs :: [Range Double]) -> prop_has rs putStrLn " * prop_unfold" check prop_unfold putStrLn " * prop_union" check $ \(rset1 :: RSet Double) -> prop_union rset1 putStrLn " * prop_intersection" check $ \(rset1 :: RSet Double) -> prop_intersection rset1 putStrLn " * prop_difference" check $ \(rset1 :: RSet Double) -> prop_difference rset1 putStrLn " * prop_negation" check $ \(rset1 :: RSet Double) -> prop_negation rset1 putStrLn " * prop_not_empty" check $ \(rset1 :: RSet Double) -> prop_not_empty rset1 putStrLn " * prop_empty" check $ \(v :: Double) -> prop_empty v putStrLn " * prop_full" check $ \(v :: Double) -> prop_full v putStrLn " * prop_empty_intersection" check $ \(rset1 :: RSet Double) -> prop_empty_intersection rset1 putStrLn " * prop_full_union" check $ \(rset1 :: RSet Double) -> prop_full_union rset1 putStrLn " * prop_union_superset" check $ \(rset1 :: RSet Double) -> prop_union_superset rset1 putStrLn " * prop_intersection_subset" check $ \(rset1 :: RSet Double) -> prop_intersection_subset rset1 putStrLn " * prop_diff_intersect" check $ \(rset1 :: RSet Double) -> prop_diff_intersect rset1 putStrLn " * prop_subset" check $ \(rset1 :: RSet Double) -> prop_subset rset1 putStrLn " * prop_strict_subset" check $ \(rset1 :: RSet Double) -> prop_strict_subset rset1 putStrLn " * prop_union_strict_superset" check $ \(rset1 :: RSet Double) -> prop_union_strict_superset rset1 putStrLn " * prop_intersection_commutes" check $ \(rset1 :: RSet Double) -> prop_intersection_commutes rset1 putStrLn " * prop_union_commutes" check $ \(rset1 :: RSet Double) -> prop_union_commutes rset1 putStrLn " * prop_intersection_associates" check $ \(rset1 :: RSet Double) -> prop_intersection_associates rset1 putStrLn " * prop_union_associates" check $ \(rset1 :: RSet Double) -> prop_union_associates rset1 putStrLn " * prop_de_morgan_intersection" check $ \(rset1 :: RSet Double) -> prop_de_morgan_intersection rset1 putStrLn " * prop_de_morgan_union" check $ \(rset1 :: RSet Double) -> prop_de_morgan_union rset1