diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -35,3 +35,9 @@ Added lots more QuickCheck properties. Added subset predicates. Added infix operators. + +Version 0.2.0 +------------- + +Reorganised and extended tests. +Added "rangeIsFull" predicate. diff --git a/Data/Ranged.hs b/Data/Ranged.hs --- a/Data/Ranged.hs +++ b/Data/Ranged.hs @@ -1,4 +1,3 @@ - module Data.Ranged ( module Data.Ranged.Boundaries, module Data.Ranged.Ranges, diff --git a/Data/Ranged/Boundaries.hs b/Data/Ranged/Boundaries.hs --- a/Data/Ranged/Boundaries.hs +++ b/Data/Ranged/Boundaries.hs @@ -9,13 +9,11 @@ -- ----------------------------------------------------------------------------- - - module Data.Ranged.Boundaries ( - DiscreteOrdered, - adjacent, + DiscreteOrdered (..), enumAdjacent, boundedAdjacent, + boundedBelow, Boundary (..), above, (/>/) @@ -26,9 +24,9 @@ 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 +{- | +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 @@ -37,68 +35,127 @@ 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 + -- | 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 -instance DiscreteOrdered Bool where adjacent = boundedAdjacent -instance DiscreteOrdered Ordering where adjacent = boundedAdjacent -instance DiscreteOrdered Char where adjacent = boundedAdjacent -instance DiscreteOrdered Int where adjacent = boundedAdjacent -instance DiscreteOrdered Integer where adjacent = enumAdjacent -instance Integral a => DiscreteOrdered (Ratio a) - where adjacent _ _ = False -instance DiscreteOrdered Float where adjacent _ _ = False -instance DiscreteOrdered Double where adjacent _ _ = False -instance Ord a => DiscreteOrdered [a] where adjacent _ _ = False + +-- 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 + 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 + where adjacent (x1, x2, x3) (y1, y2, y3) = (x1 == y1) && (x2 == y2) && adjacent x3 y3 -instance (Ord a, Ord b, Ord c, DiscreteOrdered d) => + 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 + 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@). Use as the definition of --- "adjacent" for most enumerated types. +-- is no value between @x@ and @succ x@). enumAdjacent :: (Ord a, Enum a) => a -> a -> Bool -enumAdjacent x y = (succ x == y) - +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 +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 +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. + +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 | + BoundaryAbove a | -- | The argument is the lowest value above the boundary. BoundaryBelow a | -- | The boundary above all values. - BoundaryAboveAll | + BoundaryAboveAll | -- | The boundary below all values. BoundaryBelowAll deriving (Show) @@ -109,37 +166,37 @@ 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. +-- 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: + -- 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 + 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 + BoundaryAbove b2 -> + if b1 > b2 + then + if adjacent b2 b1 then EQ else GT else LT BoundaryBelow b2 -> compare b1 b2 BoundaryAboveAll -> LT @@ -147,11 +204,11 @@ BoundaryAboveAll -> case boundary2 of BoundaryAboveAll -> EQ - otherwise -> GT + _ -> GT BoundaryBelowAll -> case boundary2 of BoundaryBelowAll -> EQ - otherwise -> LT + _ -> LT -- QuickCheck Generator @@ -163,7 +220,7 @@ v <- arbitrary oneof [return $ BoundaryAbove v, return $ BoundaryBelow v] )] - coarbitrary BoundaryBelowAll = variant 0 + coarbitrary BoundaryBelowAll = variant 0 coarbitrary BoundaryAboveAll = variant 1 coarbitrary (BoundaryBelow v) = variant 2 . coarbitrary v coarbitrary (BoundaryAbove v) = variant 3 . coarbitrary v diff --git a/Data/Ranged/RangedSet.hs b/Data/Ranged/RangedSet.hs --- a/Data/Ranged/RangedSet.hs +++ b/Data/Ranged/RangedSet.hs @@ -1,38 +1,59 @@ -module Data.Ranged.RangedSet ( +module Data.Ranged.RangedSet ( -- ** Ranged Set Type RSet, rSetRanges, - -- ** Ranged Set construction functions and their Preconditions + -- ** Ranged Set construction functions and their preconditions makeRangedSet, unsafeRangedSet, validRangeList, normaliseRangeList, rSingleton, + rSetUnfold, -- ** Predicates rSetIsEmpty, - (-?-), rSetHas, + rSetIsFull, + (-?-), rSetHas, (-<=-), rSetIsSubset, (-<-), rSetIsSubsetStrict, -- ** Set Operations - (-\/-), rSetUnion, - (-/\-), rSetIntersection, + (-\/-), rSetUnion, + (-/\-), rSetIntersection, (-!-), rSetDifference, rSetNegation, -- ** Useful Sets rSetEmpty, rSetFull, - rSetUnfold - -- ** QuickCheck Properties - -- *** Construction - -- $ConstructionProperties - + prop_validNormalised, + prop_has, + prop_unfold, -- *** Basic Operations - -- $BasicOperationProperties - + 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 @@ -48,7 +69,6 @@ -- | 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) @@ -71,24 +91,23 @@ -- | 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 ranges = +normaliseRangeList ranges = normalise $ sort $ filter (not . rangeIsEmpty) ranges - + -- 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 + if overlap r1 r2 then normalise $ - Range (rangeLower r1) + 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 @@ -98,7 +117,7 @@ makeRangedSet = RSet . normaliseRangeList --- | Create a new Ranged Set from a list of ranges. @validRangeList ranges@ +-- | 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 @@ -128,9 +147,9 @@ (-?-) = rSetHas --- | True if the first argument is a subset of the second argument, or is --- equal. --- +-- | 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) @@ -138,13 +157,13 @@ -- | 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) +rSetIsSubsetStrict rs1 rs2 = + rSetIsEmpty (rs1 -!- rs2) && not (rSetIsEmpty (rs2 -!- rs1)) - + (-<-) = rSetIsSubsetStrict -- | Set union for ranged sets. Infix precedence is left 6. @@ -153,25 +172,25 @@ -- sorted list and then calls normalise to combine overlapping ranges. rSetUnion (RSet ls1) (RSet ls2) = RSet $ normalise $ merge ls1 ls2 where - merge ls1 [] = ls1 - merge [] ls2 = ls2 - merge ls1@(h1:t1) ls2@(h2:t2) = + merge ms1 [] = ms1 + merge [] ms2 = ms2 + merge ms1@(h1:t1) ms2@(h2:t2) = if h1 < h2 - then h1 : merge t1 ls2 - else h2 : merge ls1 t2 + 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) = +rSetIntersection (RSet ls1) (RSet ls2) = RSet $ filter (not . rangeIsEmpty) $ merge ls1 ls2 where - merge ls1@(h1:t1) ls2@(h2:t2) = - rangeIntersection h1 h2 + merge ms1@(h1:t1) ms2@(h2:t2) = + rangeIntersection h1 h2 : if rangeUpper h1 < rangeUpper h2 - then merge t1 ls2 - else merge ls1 t2 + then merge t1 ms2 + else merge ms1 t2 merge _ _ = [] (-/\-) = rSetIntersection @@ -194,11 +213,10 @@ setBounds1 = case setBounds of (BoundaryBelowAll : bs) -> bs _ -> BoundaryBelowAll : setBounds - setBounds = bounds $ rSetRanges set + setBounds = bounds $ rSetRanges set bounds (r:rs) = rangeLower r : rangeUpper r : bounds rs bounds _ = [] - -- | The empty set. rSetEmpty :: DiscreteOrdered a => RSet a rSetEmpty = RSet [] @@ -207,32 +225,31 @@ rSetFull :: DiscreteOrdered a => RSet a rSetFull = RSet [Range BoundaryBelowAll BoundaryAboveAll] - -- | Construct a range set. -rSetUnfold :: DiscreteOrdered a => +rSetUnfold :: DiscreteOrdered a => Boundary a -- ^ A first lower boundary. - -> (Boundary a -> Boundary a) + -> (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). + -- ^ 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 $ ranges bound where - ranges b = - Range b (upperFunc bound) + ranges b = + Range b (upperFunc b) : case succFunc b of Just b2 -> ranges b2 Nothing -> [] - - + + -- QuickCheck Generators -instance (Arbitrary v, DiscreteOrdered v, Show v) => - Arbitrary (RSet v) +instance (Arbitrary v, DiscreteOrdered v, Show v) => + Arbitrary (RSet v) where arbitrary = frequency [ (1, return rSetEmpty), @@ -247,293 +264,221 @@ -- and pair them off. Odd boundaries are dropped. rangeList (b1:b2:bs) = Range b1 b2 : rangeList bs rangeList _ = [] - + coarbitrary (RSet ls) = variant 0 . coarbitrary ls --- ================================================================== +-- ================================================================== -- QuickCheck Properties -- ================================================================== --- Note for maintenance: Haddock does not include QuickCheck properties, --- so they have to be copied into documentation blocks manually. This --- process must be repeated for new or modified properties. - - --------------------------------------------------------------------- -- Construction properties --------------------------------------------------------------------- -{- $ConstructionProperties +-- | 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 -A normalised range list is valid for unsafeRangedSet -> prop_validNormalised ls = validRangeList $ normaliseRangeList ls -> where types = ls :: [Range Double] +-- | 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 -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) == rangedSet ls -?- v - --} - --- A normalised range list is valid for unsafeRangedSet -prop_validNormalised ls = validRangeList $ normaliseRangeList ls - where types = ls :: [Range Integer] +-- | 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 --- 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 - where types = v :: Integer +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 --------------------------------------------------------------------- -{- $BasicOperationProperties -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) - -Iff a value is in both of two ranged sets then it is in the intersection -of those two sets. - -> 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) - - -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) - - -A set that contains a value is not empty - -> prop_not_empty rs v = (rs -?- v) ==> not (rSetIsEmpty rs) - --} - --- Iff a value is in either of two ranged sets then it is in the union of +-- | 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) - where types = v :: Integer --- Iff a value is in both of two ranged sets then it is in the intersection +-- | 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 `rSetIntersection` rs2) -?- v) - where types = v :: Integer +-- +-- > 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 +-- | 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 = +-- +-- > 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) - where types = v :: Integer - --- Iff a value is not in a ranged set then it is in its negation. +-- | 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) - where types = v :: Integer - --- A set that contains a value is not empty +-- | 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) - where types = v :: Integer - --------------------------------------------------------------------- -- Some identities and inequalities of sets --------------------------------------------------------------------- -{- $SomeIdentitiesAndInequalities - -The empty set has no members. - -> prop_empty v = not (rSetEmpty -?- v) - - -The full set has every member. - -> prop_full v = rSetFull -?- v - - -The intersection of a set with its negation is empty. - -> 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) - - -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 - -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 - -The difference of two sets intersected with the subtractand is empty. - -> prop_diff_intersect rs1 rs2 = -> rSetIsEmpty ((rs1 -!- rs2) -/\- rs2) - -A set is the non-strict subset of itself. - -> prop_subset rs = rs -<=- rs - - -A set is not the strict subset of itself. - -> 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)) - -Intersection commutes - -> prop_intersection_commutes rs1 rs2 = -> (rs1 -/\- rs2) == (rs2 -/\- rs1) - -Union commutes - -> prop_union_commutes rs1 rs2 = -> (rs1 -\/- rs2) == (rs2 -\/- rs1) - -Intersection associates - -> 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)) - -De Morgan's Law for Intersection - -> 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) - --} - --- The empty set has no members. +-- | The empty set has no members. +-- +-- > prop_empty v = not (rSetEmpty -?- v) +prop_empty :: (DiscreteOrdered a) => a -> Bool prop_empty v = not (rSetEmpty -?- v) - where types = v :: Integer - --- The full set has every member. +-- | The full set has every member. +-- +-- > prop_full v = rSetFull -?- v +prop_full :: (DiscreteOrdered a) => a -> Bool prop_full v = rSetFull -?- v - where types = v :: Integer - --- The intersection of a set with its negation is empty. +-- | 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) - where types = rs :: RSet Integer - - --- The union of a set with its negation is full. + 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) - where types = rs :: RSet Integer - --- The union of two sets is the non-strict superset of both. +-- | 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 + rs1 -<=- u && rs2 -<=- u where - u :: RSet Integer u = rs1 -\/- rs2 - --- The intersection of two sets is the non-strict subset of both. -prop_intersection_subset rs1 rs2 = - i -<=- rs1 && i -<=- 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 :: RSet Integer i = rs1 -/\- rs2 --- The difference of two sets intersected with the subtractand is empty. -prop_diff_intersect rs1 rs2 = - rSetIsEmpty ((rs1 -!- rs2) -/\- rs2) - where types = rs1 :: RSet Integer - - --- A set is the non-strict subset of itself. -prop_subset rs = - rs -<=- rs - where types = rs :: RSet Integer - --- A set is not the strict subset of itself. -prop_strict_subset rs = - not (rs -<- rs) - where types = rs :: RSet Integer - +-- | 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) --- If rs1 - rs2 is not empty then the union of rs1 and rs2 will be a strict +-- | 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)) - where types = rs1 :: RSet Integer + (not $ rSetIsEmpty (rs1 -!- rs2)) ==> (rs2 -<- (rs1 -\/- rs2)) --- Intersection commutes -prop_intersection_commutes :: RSet Integer -> RSet Integer -> Bool -prop_intersection_commutes rs1 rs2 = - (rs1 -/\- rs2) == (rs2 -/\- rs1) - where types = rs1 :: RSet Integer - --- Union commutes -prop_union_commutes rs1 rs2 = - (rs1 -\/- rs2) == (rs2 -\/- rs1) - where types = rs1 :: RSet Integer - --- Intersection associates +-- | 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)) - where types = rs1 :: RSet Integer - --- Union associates + +-- | 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)) - where types = rs1 :: RSet Integer - --- De Morgan's Law for Intersection + +-- | 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) - where types = rs1 :: RSet Integer --- De Morgan's Law for Union +-- | 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) - where types = rs1 :: RSet Integer diff --git a/Data/Ranged/Ranges.hs b/Data/Ranged/Ranges.hs --- a/Data/Ranged/Ranges.hs +++ b/Data/Ranged/Ranges.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- +-- -- Module : Data.Ranged.Ranges -- Copyright : (c) Paul Johnson 2006 -- License : BSD-style @@ -9,9 +9,7 @@ -- ----------------------------------------------------------------------------- - -- | A range has an upper and lower boundary. - module Data.Ranged.Ranges ( -- ** Construction Range (..), @@ -19,6 +17,7 @@ fullRange, -- ** Predicates rangeIsEmpty, + rangeIsFull, rangeOverlap, rangeEncloses, rangeSingletonValue, @@ -29,11 +28,24 @@ singletonRange, rangeIntersection, rangeUnion, - rangeDifference + rangeDifference, -- ** QuickCheck properties - -- $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 @@ -42,8 +54,8 @@ 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 && + r1 == r2 = (rangeIsEmpty r1 && rangeIsEmpty r2) || + (rangeLower r1 == rangeLower r2 && rangeUpper r1 == rangeUpper r2) @@ -54,11 +66,12 @@ | 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" - | otherwise = + | rangeIsFull r = "All x" + | otherwise = case rangeSingletonValue r of Just v -> "x == " ++ show v Nothing -> lowerBound ++ "x" ++ upperBound @@ -87,25 +100,46 @@ [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 _ = Nothing + | 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. @@ -113,52 +147,56 @@ 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 = +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 + + +-- | 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) + (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 (Range lower1 upper1) (Range lower2 upper2) = - Range (max lower1 lower2) (min upper1 upper2) - - +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) = - if touching - then [Range lower upper] - else [r1, r2] +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 + 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 +-- | @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) r2@(Range lower2 upper2) = + +rangeDifference r1@(Range lower1 upper1) (Range lower2 upper2) = -- There are six possibilities -- 1: r2 completely less than r1 -- 2: r2 overlaps bottom of r1 @@ -177,14 +215,14 @@ -- QuickCheck generators -instance (Arbitrary v, DiscreteOrdered v, Show v) => +instance (Arbitrary v, DiscreteOrdered v, Show v) => Arbitrary (Range v) where - + arbitrary = frequency [ (17, do -- Ordinary range b1 <- arbitrary b2 <- arbitrary - if b1 < b2 + if b1 < b2 then return $ Range b1 b2 else return $ Range b2 b1 ), @@ -195,100 +233,124 @@ (1, return emptyRange), (1, return fullRange) ] - + coarbitrary (Range lower upper) = variant 0 . coarbitrary lower . coarbitrary upper - - --- QuickCheck Properties -{- $properties -Range union -> prop_union r1 r2 n = -> (r1 `rangeHas` n || r2 `rangeHas` n) -> == (r1 `rangeUnion` r2) `rangeListHas` n - -Range intersection - -> prop_intersection r1 r2 n = -> (r1 `rangeHas` n && r2 `rangeHas` n) -> == (r1 `rangeIntersection` r2) `rangeHas` n - -Range difference - -> prop_difference r1 r2 n = -> (r1 `rangeHas` n && not (r2 `rangeHas` n)) -> == (r1 `rangeDifference` r2) `rangeListHas` n - -Singleton range - -> prop_singletonHas v = -> singletonRange v `rangeHas` v - -> prop_singletonConverse v = -> rangeSingletonValue (singletonRange v) == Just v - --} - --- For Integers (sparse type) +-- QuickCheck Properties --- Range union -prop_union_int r1 r2 n = - (r1 `rangeHas` n || r2 `rangeHas` n) +-- | 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 - where t :: Integer ; t = 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 --- Range intersection -prop_intersection_int r1 r2 n = +-- | 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 - where t :: Integer ; t = n --- Range difference -prop_difference_int r1 r2 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 - where t :: Integer ; t = n --- Range Singleton Has -prop_singletonHas_int v = - singletonRange v `rangeHas` v - where t :: Integer ; t = v +-- | 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 Singleton inverse -prop_singletonConverse_int v = +-- | 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 - where t :: Integer ; t = v --- For Reals (dense type) +-- | The empty range is not a singleton. +-- +-- > prop_emptyNonSingleton = rangeSingletonValue emptyRange == Nothing +prop_emptyNonSingleton :: Bool +prop_emptyNonSingleton = + rangeSingletonValue (emptyRange :: Range Int) == Nothing --- Range Union -prop_union_real r1 r2 n = - (r1 `rangeHas` n || r2 `rangeHas` n) - == (r1 `rangeUnion` r2) `rangeListHas` n - where t :: Double ; t = n +-- | The full range is not a singleton. +-- +-- > prop_fullNonSingleton = rangeSingletonValue fullRange == Nothing +prop_fullNonSingleton :: Bool +prop_fullNonSingleton = + rangeSingletonValue (fullRange :: Range Int) == Nothing --- Range intersection -prop_intersection_real r1 r2 n = - (r1 `rangeHas` n && r2 `rangeHas` n) - == (r1 `rangeIntersection` r2) `rangeHas` n - where t :: Double ; t = n +-- | 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)] --- Range difference -prop_difference_real r1 r2 n = - (r1 `rangeHas` n && not (r2 `rangeHas` n)) - == (r1 `rangeDifference` r2) `rangeListHas` n - where t :: Double ; t = n --- Range Singleton Has -prop_singletonHas_real v = - singletonRange v `rangeHas` v - where t :: Double ; t = v +-- | 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] + --- Range Singleton inverse -prop_singletonConverse_real v = - rangeSingletonValue (singletonRange v) == Just v - where t :: Double ; t = v diff --git a/Doc/Data-Ranged-Boundaries.html b/Doc/Data-Ranged-Boundaries.html deleted file mode 100644 --- a/Doc/Data-Ranged-Boundaries.html +++ /dev/null @@ -1,681 +0,0 @@ - - -Data.Ranged.Boundaries
ContentsIndex
Data.Ranged.Boundaries
Portabilityportable
Stabilityexperimental
Maintainerpaul@cogito.org.uk
Description
Synopsis
class Ord a => DiscreteOrdered a where
adjacent :: a -> a -> Bool
adjacent :: DiscreteOrdered a => a -> a -> Bool
enumAdjacent :: (Ord a, Enum a) => a -> a -> Bool
boundedAdjacent :: (Ord a, Enum a) => a -> a -> Bool
data Boundary a
= BoundaryAbove a
| BoundaryBelow a
| BoundaryAboveAll
| BoundaryBelowAll
above :: Ord v => Boundary v -> v -> Bool
(/>/) :: Ord v => v -> Boundary v -> Bool
Documentation
class Ord a => DiscreteOrdered a where

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. -

This approach was suggested by Ben Rudiak-Gould on comp.lang.functional. -

Methods
adjacent :: a -> a -> Bool
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. -
show/hide Instances
DiscreteOrdered Bool
DiscreteOrdered Char
DiscreteOrdered Double
DiscreteOrdered Float
DiscreteOrdered Int
DiscreteOrdered Integer
DiscreteOrdered Ordering
(Ord a, DiscreteOrdered b) => DiscreteOrdered (a, b)
(Ord a, Ord b, DiscreteOrdered c) => DiscreteOrdered (a, b, c)
(Ord a, Ord b, Ord c, DiscreteOrdered d) => DiscreteOrdered (a, b, c, d)
Integral a => DiscreteOrdered (Ratio a)
Ord a => DiscreteOrdered [a]
adjacent :: DiscreteOrdered a => a -> a -> Bool
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. -
enumAdjacent :: (Ord a, Enum a) => a -> a -> Bool
Check adjacency for sparse enumerated types (i.e. where there - is no value between x and succ x). Use as the definition of - adjacent for most enumerated types. -
boundedAdjacent :: (Ord a, Enum a) => a -> a -> Bool
Check adjacency, allowing for case where x = maxBound. Use as the - definition of adjacent for bounded enumerated types such as Int and Char. -
data Boundary a

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. -

Constructors
BoundaryAbove aThe argument is the highest value below the boundary. -
BoundaryBelow aThe argument is the lowest value above the boundary. -
BoundaryAboveAllThe boundary above all values. -
BoundaryBelowAllThe boundary below all values. -
show/hide Instances
Arbitrary a => Arbitrary (Boundary a)
DiscreteOrdered a => Eq (Boundary a)
DiscreteOrdered a => Ord (Boundary a)
Show a => Show (Boundary a)
above :: Ord v => Boundary v -> v -> Bool
True if the value is above the boundary, false otherwise. -
(/>/) :: Ord v => v -> Boundary v -> Bool
Same as above, but with the arguments reversed for more intuitive infix - usage. -
Produced by Haddock version 0.8
diff --git a/Doc/Data-Ranged-RangedSet.html b/Doc/Data-Ranged-RangedSet.html deleted file mode 100644 --- a/Doc/Data-Ranged-RangedSet.html +++ /dev/null @@ -1,1456 +0,0 @@ - - -Data.Ranged.RangedSet
ContentsIndex
Data.Ranged.RangedSet
Contents
Ranged Set Type -
Ranged Set construction functions and their Preconditions -
Predicates -
Set Operations -
Useful Sets -
QuickCheck Properties -
Construction -
Basic Operations -
Some Identities and Inequalities -
Synopsis
data RSet v
rSetRanges :: RSet v -> [Range v]
makeRangedSet :: DiscreteOrdered v => [Range v] -> RSet v
unsafeRangedSet :: DiscreteOrdered v => [Range v] -> RSet v
validRangeList :: DiscreteOrdered v => [Range v] -> Bool
normaliseRangeList :: DiscreteOrdered v => [Range v] -> [Range v]
rSingleton :: DiscreteOrdered v => v -> RSet v
rSetIsEmpty :: DiscreteOrdered v => RSet v -> Bool
(-?-) :: DiscreteOrdered v => RSet v -> v -> Bool
rSetHas :: DiscreteOrdered v => RSet v -> v -> Bool
(-<=-) :: DiscreteOrdered v => RSet v -> RSet v -> Bool
rSetIsSubset :: DiscreteOrdered v => RSet v -> RSet v -> Bool
(-<-) :: DiscreteOrdered v => RSet v -> RSet v -> Bool
rSetIsSubsetStrict :: DiscreteOrdered v => RSet v -> RSet v -> Bool
(-\/-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetUnion :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
(-/\-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetIntersection :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
(-!-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetDifference :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetNegation :: DiscreteOrdered a => RSet a -> RSet a
rSetEmpty :: DiscreteOrdered a => RSet a
rSetFull :: DiscreteOrdered a => RSet a
rSetUnfold :: DiscreteOrdered a => Boundary a -> (Boundary a -> Boundary a) -> (Boundary a -> Maybe (Boundary a)) -> RSet a
Ranged Set Type -
data RSet v
An RSet (for Ranged Set) is a list of ranges. The ranges must be sorted - and not overlap. -
show/hide Instances
(Arbitrary v, DiscreteOrdered v, Show v) => Arbitrary (RSet v)
(DiscreteOrdered v, ??? v) => Eq (RSet v)
DiscreteOrdered a => Monoid (RSet a)
(DiscreteOrdered v, ??? v) => Show (RSet v)
rSetRanges :: RSet v -> [Range v]
Ranged Set construction functions and their Preconditions -
makeRangedSet :: DiscreteOrdered v => [Range v] -> RSet v
Create a new Ranged Set from a list of ranges. The list may contain - ranges that overlap or are not in ascending order. -
unsafeRangedSet :: DiscreteOrdered v => [Range v] -> RSet v
Create a new Ranged Set from a list of ranges. validRangeList ranges - must return True. This precondition is not checked. -
validRangeList :: DiscreteOrdered v => [Range v] -> Bool
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. -
normaliseRangeList :: DiscreteOrdered v => [Range v] -> [Range v]
Rearrange and merge the ranges in the list so that they are in order and - non-overlapping. -
rSingleton :: DiscreteOrdered v => v -> RSet v
Create a Ranged Set from a single element. -
Predicates -
rSetIsEmpty :: DiscreteOrdered v => RSet v -> Bool
True if the set has no members. -
(-?-) :: DiscreteOrdered v => RSet v -> v -> Bool
rSetHas :: DiscreteOrdered v => RSet v -> v -> Bool
True if the value is within the ranged set. Infix precedence is left 5. -
(-<=-) :: DiscreteOrdered v => RSet v -> RSet v -> Bool
rSetIsSubset :: DiscreteOrdered v => RSet v -> RSet v -> Bool

True if the first argument is a subset of the second argument, or is - equal. -

Infix precedence is left 5. -

(-<-) :: DiscreteOrdered v => RSet v -> RSet v -> Bool
rSetIsSubsetStrict :: DiscreteOrdered v => RSet v -> RSet v -> Bool

True if the first argument is a strict subset of the second argument. -

Infix precedence is left 5. -

Set Operations -
(-\/-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetUnion :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
Set union for ranged sets. Infix precedence is left 6. -
(-/\-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetIntersection :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
Set intersection for ranged sets. Infix precedence is left 7. -
(-!-) :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
rSetDifference :: DiscreteOrdered v => RSet v -> RSet v -> RSet v
Set difference. Infix precedence is left 6. -
rSetNegation :: DiscreteOrdered a => RSet a -> RSet a
Set negation. -
Useful Sets -
rSetEmpty :: DiscreteOrdered a => RSet a
The empty set. -
rSetFull :: DiscreteOrdered a => RSet a
The set that contains everything. -
rSetUnfold
:: DiscreteOrdered a
=> Boundary aA 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). -
-> RSet a
Construct a range set. -
QuickCheck Properties -
Construction -

A normalised range list is valid for unsafeRangedSet -

 prop_validNormalised ls = validRangeList $ normaliseRangeList ls
-    where types = ls :: [Range Double]
-

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) == rangedSet ls -?- v
-
Basic Operations -

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)
-

Iff a value is in both of two ranged sets then it is in the intersection -of those two sets. -

 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)
-

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)
-

A set that contains a value is not empty -

 prop_not_empty rs v = (rs -?- v) ==> not (rSetIsEmpty rs)
-
Some Identities and Inequalities -

The empty set has no members. -

 prop_empty v = not (rSetEmpty -?- v)
-

The full set has every member. -

 prop_full v = rSetFull -?- v
-

The intersection of a set with its negation is empty. -

 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)
-

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
-

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
-

The difference of two sets intersected with the subtractand is empty. -

 prop_diff_intersect rs1 rs2 =
-    rSetIsEmpty ((rs1 -!- rs2) -/\- rs2)
-

A set is the non-strict subset of itself. -

 prop_subset rs = rs -<=- rs
-

A set is not the strict subset of itself. -

 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))
-

Intersection commutes -

 prop_intersection_commutes rs1 rs2 =
-    (rs1 -/\- rs2) == (rs2 -/\- rs1)
-

Union commutes -

 prop_union_commutes rs1 rs2 =
-    (rs1 -\/- rs2) == (rs2 -\/- rs1)
-

Intersection associates -

 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))
-

De Morgan's Law for Intersection -

 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)
-
Produced by Haddock version 0.8
diff --git a/Doc/Data-Ranged-Ranges.html b/Doc/Data-Ranged-Ranges.html deleted file mode 100644 --- a/Doc/Data-Ranged-Ranges.html +++ /dev/null @@ -1,838 +0,0 @@ - - -Data.Ranged.Ranges
ContentsIndex
Data.Ranged.Ranges
Contents
Construction -
Predicates -
Membership -
Set Operations -
QuickCheck properties -
Description
A range has an upper and lower boundary. -
Synopsis
data Range v = Range {
rangeLower, rangeUpper :: (Boundary v)
}
emptyRange :: DiscreteOrdered v => Range v
fullRange :: DiscreteOrdered v => Range v
rangeIsEmpty :: DiscreteOrdered v => Range v -> Bool
rangeOverlap :: DiscreteOrdered v => Range v -> Range v -> Bool
rangeEncloses :: DiscreteOrdered v => Range v -> Range v -> Bool
rangeSingletonValue :: DiscreteOrdered v => Range v -> Maybe v
rangeHas :: Ord v => Range v -> v -> Bool
rangeListHas :: Ord v => [Range v] -> v -> Bool
singletonRange :: DiscreteOrdered v => v -> Range v
rangeIntersection :: DiscreteOrdered v => Range v -> Range v -> Range v
rangeUnion :: DiscreteOrdered v => Range v -> Range v -> [Range v]
rangeDifference :: DiscreteOrdered v => Range v -> Range v -> [Range v]
Construction -
data Range v
A Range has upper and lower boundaries. -
Constructors
Range
rangeLower, rangeUpper :: (Boundary v)
show/hide Instances
(Arbitrary v, DiscreteOrdered v, Show v) => Arbitrary (Range v)
DiscreteOrdered a => Eq (Range a)
DiscreteOrdered a => Ord (Range a)
(Show a, DiscreteOrdered a) => Show (Range a)
emptyRange :: DiscreteOrdered v => Range v
The empty range -
fullRange :: DiscreteOrdered v => Range v
The full range. All values are within it. -
Predicates -
rangeIsEmpty :: DiscreteOrdered v => Range v -> Bool
A range is empty unless its upper boundary is greater than its lower - boundary. -
rangeOverlap :: DiscreteOrdered v => Range v -> Range v -> Bool
Two ranges overlap if their intersection is non-empty. -
rangeEncloses :: DiscreteOrdered v => Range v -> Range v -> Bool
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. -
rangeSingletonValue :: DiscreteOrdered v => Range v -> Maybe v
If the range is a singleton, returns Just the value. Otherwise returns - Nothing. -
Membership -
rangeHas :: Ord v => Range v -> v -> Bool
True if the value is within the range. -
rangeListHas :: Ord v => [Range v] -> v -> Bool
True if the value is within one of the ranges. -
Set Operations -
singletonRange :: DiscreteOrdered v => v -> Range v
A range containing a single value -
rangeIntersection :: DiscreteOrdered v => Range v -> Range v -> Range v
Intersection of two ranges, if any. -
rangeUnion :: DiscreteOrdered v => Range v -> Range v -> [Range v]

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. -

rangeDifference :: DiscreteOrdered v => Range v -> Range v -> [Range v]
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. -
QuickCheck properties -

Range union -

 prop_union r1 r2 n =
-    (r1 `rangeHas` n || r2 `rangeHas` n) 
-    == (r1 `rangeUnion` r2) `rangeListHas` n
-

Range intersection -

 prop_intersection r1 r2 n =
-    (r1 `rangeHas` n && r2 `rangeHas` n)
-    == (r1 `rangeIntersection` r2) `rangeHas` n
-

Range difference -

 prop_difference r1 r2 n =
-    (r1 `rangeHas` n && not (r2 `rangeHas` n))
-    == (r1 `rangeDifference` r2) `rangeListHas` n
-

Singleton range -

 prop_singletonHas v =
-    singletonRange v `rangeHas` v
-
 prop_singletonConverse v =
-    rangeSingletonValue (singletonRange v) == Just v
-
Produced by Haddock version 0.8
diff --git a/Doc/Data-Ranged.html b/Doc/Data-Ranged.html deleted file mode 100644 --- a/Doc/Data-Ranged.html +++ /dev/null @@ -1,106 +0,0 @@ - - -Data.Ranged
ContentsIndex
Data.Ranged
Documentation
module Data.Ranged.Boundaries
module Data.Ranged.Ranges
module Data.Ranged.RangedSet
Produced by Haddock version 0.8
diff --git a/Doc/doc-index.html b/Doc/doc-index.html deleted file mode 100644 --- a/Doc/doc-index.html +++ /dev/null @@ -1,454 +0,0 @@ - - - (Index)
ContentsIndex
-!-Data.Ranged.RangedSet, Data.Ranged
-/\-Data.Ranged.RangedSet, Data.Ranged
-<-Data.Ranged.RangedSet, Data.Ranged
-<=-Data.Ranged.RangedSet, Data.Ranged
-?-Data.Ranged.RangedSet, Data.Ranged
-\/-Data.Ranged.RangedSet, Data.Ranged
/>/Data.Ranged.Boundaries, Data.Ranged
BoundaryData.Ranged.Boundaries, Data.Ranged
BoundaryAboveData.Ranged.Boundaries, Data.Ranged
BoundaryAboveAllData.Ranged.Boundaries, Data.Ranged
BoundaryBelowData.Ranged.Boundaries, Data.Ranged
BoundaryBelowAllData.Ranged.Boundaries, Data.Ranged
DiscreteOrderedData.Ranged.Boundaries, Data.Ranged
RSetData.Ranged.RangedSet, Data.Ranged
Range
1 (Type/Class)Data.Ranged.Ranges, Data.Ranged
2 (Data Constructor)Data.Ranged.Ranges, Data.Ranged
aboveData.Ranged.Boundaries, Data.Ranged
adjacentData.Ranged.Boundaries, Data.Ranged
boundedAdjacentData.Ranged.Boundaries, Data.Ranged
emptyRangeData.Ranged.Ranges, Data.Ranged
enumAdjacentData.Ranged.Boundaries, Data.Ranged
fullRangeData.Ranged.Ranges, Data.Ranged
makeRangedSetData.Ranged.RangedSet, Data.Ranged
normaliseRangeListData.Ranged.RangedSet, Data.Ranged
rSetDifferenceData.Ranged.RangedSet, Data.Ranged
rSetEmptyData.Ranged.RangedSet, Data.Ranged
rSetFullData.Ranged.RangedSet, Data.Ranged
rSetHasData.Ranged.RangedSet, Data.Ranged
rSetIntersectionData.Ranged.RangedSet, Data.Ranged
rSetIsEmptyData.Ranged.RangedSet, Data.Ranged
rSetIsSubsetData.Ranged.RangedSet, Data.Ranged
rSetIsSubsetStrictData.Ranged.RangedSet, Data.Ranged
rSetNegationData.Ranged.RangedSet, Data.Ranged
rSetRangesData.Ranged.RangedSet, Data.Ranged
rSetUnfoldData.Ranged.RangedSet, Data.Ranged
rSetUnionData.Ranged.RangedSet, Data.Ranged
rSingletonData.Ranged.RangedSet, Data.Ranged
rangeDifferenceData.Ranged.Ranges, Data.Ranged
rangeEnclosesData.Ranged.Ranges, Data.Ranged
rangeHasData.Ranged.Ranges, Data.Ranged
rangeIntersectionData.Ranged.Ranges, Data.Ranged
rangeIsEmptyData.Ranged.Ranges, Data.Ranged
rangeListHasData.Ranged.Ranges, Data.Ranged
rangeLowerData.Ranged.Ranges, Data.Ranged
rangeOverlapData.Ranged.Ranges, Data.Ranged
rangeSingletonValueData.Ranged.Ranges, Data.Ranged
rangeUnionData.Ranged.Ranges, Data.Ranged
rangeUpperData.Ranged.Ranges, Data.Ranged
singletonRangeData.Ranged.Ranges, Data.Ranged
unsafeRangedSetData.Ranged.RangedSet, Data.Ranged
validRangeListData.Ranged.RangedSet, Data.Ranged
diff --git a/Doc/index.html b/Doc/index.html deleted file mode 100644 --- a/Doc/index.html +++ /dev/null @@ -1,120 +0,0 @@ - - -
ContentsIndex
Modules
show/hideData
show/hideData.Ranged
Data.Ranged.Boundaries
Data.Ranged.RangedSet
Data.Ranged.Ranges
Produced by Haddock version 0.8
diff --git a/README.txt b/README.txt --- a/README.txt +++ b/README.txt @@ -110,10 +110,14 @@ Unfortunately there is no simple way to guarantee that computations on infinite sets will terminate. So infinite sets are not supported. -QuickCheck ----------- +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. diff --git a/Ranged-sets.cabal b/Ranged-sets.cabal --- a/Ranged-sets.cabal +++ b/Ranged-sets.cabal @@ -1,17 +1,21 @@ Name: Ranged-sets -Version: 0.1.1 +Version: 0.2.0 License: BSD3 License-file: LICENSE.txt -Copyright: Paul Johnson, 2005, 2006, 2007 +Copyright: Paul Johnson, 2005, 2006, 2007, 2008 Author: Paul Johnson -Homepage: http://ranged-sets.sourceforge.net/ +Homepage: http://code.haskell.org/ranged-sets Maintainer: paul@cogito.org.uk Stability: beta -Category: Data -Build-Depends: base, QuickCheck +Category: Data +Build-Depends: base, QuickCheck, HUnit +Build-type: Simple 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 +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). -Exposed-modules: Data.Ranged, Data.Ranged.Boundaries, Data.Ranged.Ranges, Data.Ranged.RangedSet -Extra-source-files: README.txt CHANGES.txt INSTALL.txt TODO.txt Doc/Data-Ranged-Boundaries.html Doc/Data-Ranged.html Doc/Data-Ranged-RangedSet.html Doc/Data-Ranged-Ranges.html Doc/doc-index.html Doc/index.html +Exposed-modules: Data.Ranged, Data.Ranged.Boundaries, Data.Ranged.Ranges, + Data.Ranged.RangedSet +Extra-source-files: tests/Makefile, tests/Main.hs, README.txt, CHANGES.txt, + INSTALL.txt, TODO.txt +ghc-options: -Wall diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,184 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +module Main where + +import Data.Ranged +import Test.HUnit +import Test.QuickCheck + + +conf :: Config +conf = defaultConfig { configMaxTest = 1000, configMaxFail = 10000 } + + +main :: IO () +main = do + putStrLn "QuickCheck Data.Ranged.Ranges:" + putStrLn " Sparse type Integer:" + putStrLn " * prop_unionRange" + check conf $ \(r1 :: Range Integer) -> prop_unionRange r1 + putStrLn " * prop_unionRangeLength" + check conf $ \(r1 :: Range Integer) -> prop_unionRangeLength r1 + putStrLn " * prop_intersectionRange" + check conf $ \(r1 :: Range Integer) -> prop_intersectionRange r1 + putStrLn " * prop_intersectionOverlap" + check conf $ \(r1 :: Range Integer) -> prop_intersectionOverlap r1 + putStrLn " * prop_enclosureUnion" + check conf $ \(r1 :: Range Integer) -> prop_enclosureUnion r1 + putStrLn " * prop_differenceRange" + check conf $ \(r1 :: Range Integer) -> prop_differenceRange r1 + putStrLn " * prop_singletonRangeHas" + check conf $ \(v :: Integer) -> prop_singletonRangeHas v + putStrLn " * prop_singletonRangeHasOnly" + check conf $ \(v :: Integer) -> prop_singletonRangeHasOnly v + putStrLn " * prop_singletonRangeConverse" + check conf $ \(v :: Integer) -> prop_singletonRangeConverse v + + putStrLn " Dense type Double:" + putStrLn " * prop_unionRange" + check conf $ \(r1 :: Range Double) -> prop_unionRange r1 + putStrLn " * prop_unionRangeLength" + check conf $ \(r1 :: Range Double) -> prop_unionRangeLength r1 + putStrLn " * prop_intersectionRange" + check conf $ \(r1 :: Range Double) -> prop_intersectionRange r1 + putStrLn " * prop_intersectionOverlap" + check conf $ \(r1 :: Range Integer) -> prop_intersectionOverlap r1 + putStrLn " * prop_enclosureUnion" + check conf $ \(r1 :: Range Integer) -> prop_enclosureUnion r1 + putStrLn " * prop_differenceRange" + check conf $ \(r1 :: Range Double) -> prop_differenceRange r1 + putStrLn " * prop_singletonRangeHas" + check conf $ \(v :: Double) -> prop_singletonRangeHas v + putStrLn " * prop_singletonRangeHasOnly" + check conf $ \(v :: Double) -> prop_singletonRangeHasOnly v + putStrLn " * prop_singletonRangeConverse" + check conf $ \(v :: Double) -> prop_singletonRangeConverse v + + putStrLn " Type-insensitive tests:" + putStrLn " * prop_emptyNonSingleton" + check conf prop_emptyNonSingleton + putStrLn " * prop_fullNonSingleton" + check conf prop_fullNonSingleton + putStrLn " * prop_nonSingleton" + check conf prop_nonSingleton + putStrLn " * prop_intSingleton" + check conf 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 conf $ \(rs :: [Range Integer]) -> prop_validNormalised rs + putStrLn " * prop_has" + check conf $ \(rs :: [Range Integer]) -> prop_has rs + putStrLn " * prop_unfold" + check conf prop_unfold + putStrLn " * prop_union" + check conf $ \(rset1 :: RSet Integer) -> prop_union rset1 + putStrLn " * prop_intersection" + check conf $ \(rset1 :: RSet Integer) -> prop_intersection rset1 + putStrLn " * prop_difference" + check conf $ \(rset1 :: RSet Integer) -> prop_difference rset1 + putStrLn " * prop_negation" + check conf $ \(rset1 :: RSet Integer) -> prop_negation rset1 + putStrLn " * prop_not_empty" + check conf $ \(rset1 :: RSet Integer) -> prop_not_empty rset1 + putStrLn " * prop_empty" + check conf $ \(v :: Integer) -> prop_empty v + putStrLn " * prop_full" + check conf $ \(v :: Integer) -> prop_full v + putStrLn " * prop_empty_intersection" + check conf $ \(rset1 :: RSet Integer) -> prop_empty_intersection rset1 + putStrLn " * prop_full_union" + check conf $ \(rset1 :: RSet Integer) -> prop_full_union rset1 + putStrLn " * prop_union_superset" + check conf $ \(rset1 :: RSet Integer) -> prop_union_superset rset1 + putStrLn " * prop_intersection_subset" + check conf $ \(rset1 :: RSet Integer) -> prop_intersection_subset rset1 + putStrLn " * prop_diff_intersect" + check conf $ \(rset1 :: RSet Integer) -> prop_diff_intersect rset1 + putStrLn " * prop_subset" + check conf $ \(rset1 :: RSet Integer) -> prop_subset rset1 + putStrLn " * prop_strict_subset" + check conf $ \(rset1 :: RSet Integer) -> prop_strict_subset rset1 + putStrLn " * prop_union_strict_superset" + check conf $ \(rset1 :: RSet Integer) -> prop_union_strict_superset rset1 + putStrLn " * prop_intersection_commutes" + check conf $ \(rset1 :: RSet Integer) -> prop_intersection_commutes rset1 + putStrLn " * prop_union_commutes" + check conf $ \(rset1 :: RSet Integer) -> prop_union_commutes rset1 + putStrLn " * prop_intersection_associates" + check conf $ \(rset1 :: RSet Integer) -> prop_intersection_associates rset1 + putStrLn " * prop_union_associates" + check conf $ \(rset1 :: RSet Integer) -> prop_union_associates rset1 + putStrLn " * prop_de_morgan_intersection" + check conf $ \(rset1 :: RSet Integer) -> prop_de_morgan_intersection rset1 + putStrLn " * prop_de_morgan_union" + check conf $ \(rset1 :: RSet Integer) -> prop_de_morgan_union rset1 + + putStrLn " Dense type Double:" + putStrLn " * prop_validNormalised" + check conf $ \(rs :: [Range Double]) -> prop_validNormalised rs + putStrLn " * prop_has" + check conf $ \(rs :: [Range Double]) -> prop_has rs + putStrLn " * prop_unfold" + check conf prop_unfold + putStrLn " * prop_union" + check conf $ \(rset1 :: RSet Double) -> prop_union rset1 + putStrLn " * prop_intersection" + check conf $ \(rset1 :: RSet Double) -> prop_intersection rset1 + putStrLn " * prop_difference" + check conf $ \(rset1 :: RSet Double) -> prop_difference rset1 + putStrLn " * prop_negation" + check conf $ \(rset1 :: RSet Double) -> prop_negation rset1 + putStrLn " * prop_not_empty" + check conf $ \(rset1 :: RSet Double) -> prop_not_empty rset1 + putStrLn " * prop_empty" + check conf $ \(v :: Double) -> prop_empty v + putStrLn " * prop_full" + check conf $ \(v :: Double) -> prop_full v + putStrLn " * prop_empty_intersection" + check conf $ \(rset1 :: RSet Double) -> prop_empty_intersection rset1 + putStrLn " * prop_full_union" + check conf $ \(rset1 :: RSet Double) -> prop_full_union rset1 + putStrLn " * prop_union_superset" + check conf $ \(rset1 :: RSet Double) -> prop_union_superset rset1 + putStrLn " * prop_intersection_subset" + check conf $ \(rset1 :: RSet Double) -> prop_intersection_subset rset1 + putStrLn " * prop_diff_intersect" + check conf $ \(rset1 :: RSet Double) -> prop_diff_intersect rset1 + putStrLn " * prop_subset" + check conf $ \(rset1 :: RSet Double) -> prop_subset rset1 + putStrLn " * prop_strict_subset" + check conf $ \(rset1 :: RSet Double) -> prop_strict_subset rset1 + putStrLn " * prop_union_strict_superset" + check conf $ \(rset1 :: RSet Double) -> prop_union_strict_superset rset1 + putStrLn " * prop_intersection_commutes" + check conf $ \(rset1 :: RSet Double) -> prop_intersection_commutes rset1 + putStrLn " * prop_union_commutes" + check conf $ \(rset1 :: RSet Double) -> prop_union_commutes rset1 + putStrLn " * prop_intersection_associates" + check conf $ \(rset1 :: RSet Double) -> prop_intersection_associates rset1 + putStrLn " * prop_union_associates" + check conf $ \(rset1 :: RSet Double) -> prop_union_associates rset1 + putStrLn " * prop_de_morgan_intersection" + check conf $ \(rset1 :: RSet Double) -> prop_de_morgan_intersection rset1 + putStrLn " * prop_de_morgan_union" + check conf $ \(rset1 :: RSet Double) -> prop_de_morgan_union rset1 + diff --git a/tests/Makefile b/tests/Makefile new file mode 100644 --- /dev/null +++ b/tests/Makefile @@ -0,0 +1,16 @@ +# 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 +