diff --git a/CHANGES.txt b/CHANGES.txt new file mode 100644 --- /dev/null +++ b/CHANGES.txt @@ -0,0 +1,37 @@ +Version 0.0.4 +------------- + +Added Monoid instances and singleton ranges, courtesy of Jean-Philippe +Bernardy. + +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.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. diff --git a/Data/Ranged.hs b/Data/Ranged.hs new file mode 100644 --- /dev/null +++ b/Data/Ranged.hs @@ -0,0 +1,10 @@ + +module 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 diff --git a/Data/Ranged/Boundaries.hs b/Data/Ranged/Boundaries.hs new file mode 100644 --- /dev/null +++ b/Data/Ranged/Boundaries.hs @@ -0,0 +1,170 @@ +----------------------------------------------------------------------------- +-- | +-- 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, + adjacent, + enumAdjacent, + boundedAdjacent, + 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. + +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 + +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 +instance (Ord a, DiscreteOrdered b) => DiscreteOrdered (a, b) + where adjacent (x1, x2) (y1, y2) = (x1 == y1) && adjacent x2 y2 +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 +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 + +-- | 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. +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 + + +{- | +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 + otherwise -> GT + BoundaryBelowAll -> + case boundary2 of + BoundaryBelowAll -> EQ + otherwise -> 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] + )] + 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 new file mode 100644 --- /dev/null +++ b/Data/Ranged/RangedSet.hs @@ -0,0 +1,539 @@ +module Data.Ranged.RangedSet ( + -- ** Ranged Set Type + RSet, + rSetRanges, + -- ** Ranged Set construction functions and their Preconditions + makeRangedSet, + unsafeRangedSet, + validRangeList, + normaliseRangeList, + rSingleton, + -- ** Predicates + rSetIsEmpty, + (-?-), rSetHas, + (-<=-), rSetIsSubset, + (-<-), rSetIsSubsetStrict, + -- ** Set Operations + (-\/-), rSetUnion, + (-/\-), rSetIntersection, + (-!-), rSetDifference, + rSetNegation, + -- ** Useful Sets + rSetEmpty, + rSetFull, + rSetUnfold + + -- ** QuickCheck Properties + + -- *** Construction + -- $ConstructionProperties + + -- *** Basic Operations + -- $BasicOperationProperties + + -- *** Some Identities and Inequalities + -- $SomeIdentitiesAndInequalities +) 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 ranges = and $ zipWith okAdjacent ranges (tail ranges) + 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 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 + 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 ls1 [] = ls1 + merge [] ls2 = ls2 + merge ls1@(h1:t1) ls2@(h2:t2) = + if h1 < h2 + then h1 : merge t1 ls2 + else h2 : merge ls1 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 ls1@(h1:t1) ls2@(h2:t2) = + rangeIntersection h1 h2 + : if rangeUpper h1 < rangeUpper h2 + then merge t1 ls2 + else merge ls1 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 $ ranges $ setBounds1 + where + ranges (b1:b2:bs) = Range b1 b2 : ranges bs + ranges [BoundaryAboveAll] = [] + ranges [b] = [Range b BoundaryAboveAll] + ranges _ = [] + 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). + -> RSet a +rSetUnfold bound upperFunc succFunc = RSet $ normalise $ ranges bound + where + ranges b = + Range b (upperFunc bound) + : case succFunc b of + Just b2 -> ranges 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 _ = [] + + 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 +> 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 + +-} + +-- A normalised range list is valid for unsafeRangedSet +prop_validNormalised ls = validRangeList $ normaliseRangeList ls + where types = ls :: [Range Integer] + +-- 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 + +--------------------------------------------------------------------- +-- 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 +-- those two sets. +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 +-- of those two sets. +prop_intersection rs1 rs2 v = + (rs1 -?- v && rs2 -?- v) == ((rs1 `rSetIntersection` rs2) -?- v) + where types = v :: Integer + + +-- 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) + where types = v :: Integer + + +-- 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) + where types = v :: Integer + + +-- A set that contains a value is not empty +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. +prop_empty v = not (rSetEmpty -?- v) + where types = v :: Integer + + +-- The full set has every member. +prop_full v = rSetFull -?- v + where types = v :: Integer + + +-- The intersection of a set with its negation is empty. +prop_empty_intersection rs = + rSetIsEmpty (rs -/\- rSetNegation rs) + where types = rs :: RSet Integer + + +-- The union of a set with its negation is full. +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. +prop_union_superset rs1 rs2 = + 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 + 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 + + +-- 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)) + where types = rs1 :: RSet Integer + +-- 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 +prop_intersection_associates rs1 rs2 rs3 = + ((rs1 -/\- rs2) -/\- rs3) == (rs1 -/\- (rs2 -/\- rs3)) + where types = rs1 :: RSet Integer + +-- Union associates +prop_union_associates rs1 rs2 rs3 = + ((rs1 -\/- rs2) -\/- rs3) == (rs1 -\/- (rs2 -\/- rs3)) + where types = rs1 :: RSet Integer + +-- De Morgan's Law for Intersection +prop_de_morgan_intersection rs1 rs2 = + rSetNegation (rs1 -/\- rs2) == (rSetNegation rs1 -\/- rSetNegation rs2) + where types = rs1 :: RSet Integer + +-- De Morgan's Law for Union +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 new file mode 100644 --- /dev/null +++ b/Data/Ranged/Ranges.hs @@ -0,0 +1,294 @@ +----------------------------------------------------------------------------- +-- +-- 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, + rangeOverlap, + rangeEncloses, + rangeSingletonValue, + -- ** Membership + rangeHas, + rangeListHas, + -- ** Set Operations + singletonRange, + rangeIntersection, + rangeUnion, + rangeDifference + -- ** QuickCheck properties + -- $properties +) where + +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" + | 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@. +rangeSingletonValue :: DiscreteOrdered v => Range v -> Maybe v +rangeSingletonValue (Range (BoundaryBelow v1) (BoundaryAbove v2)) + | v1 == v2 = Just v1 + | otherwise = Nothing +rangeSingletonValue _ = 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 + + +-- | 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 (Range lower1 upper1) (Range lower2 upper2) = + 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] + 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) r2@(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) + ] + + 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) + +-- Range union +prop_union_int r1 r2 n = + (r1 `rangeHas` n || r2 `rangeHas` n) + == (r1 `rangeUnion` r2) `rangeListHas` n + where t :: Integer ; t = n + + +-- Range intersection +prop_intersection_int 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 = + (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 + +-- Range Singleton inverse +prop_singletonConverse_int v = + rangeSingletonValue (singletonRange v) == Just v + where t :: Integer ; t = v + +-- For Reals (dense type) + +-- Range Union +prop_union_real r1 r2 n = + (r1 `rangeHas` n || r2 `rangeHas` n) + == (r1 `rangeUnion` r2) `rangeListHas` n + where t :: Double ; t = n + +-- Range intersection +prop_intersection_real r1 r2 n = + (r1 `rangeHas` n && r2 `rangeHas` n) + == (r1 `rangeIntersection` r2) `rangeHas` n + where t :: Double ; t = n + +-- 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 + +-- 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 new file mode 100644 --- /dev/null +++ b/Doc/Data-Ranged-Boundaries.html @@ -0,0 +1,681 @@ + + +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 new file mode 100644 --- /dev/null +++ b/Doc/Data-Ranged-RangedSet.html @@ -0,0 +1,1456 @@ + + +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 new file mode 100644 --- /dev/null +++ b/Doc/Data-Ranged-Ranges.html @@ -0,0 +1,838 @@ + + +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 new file mode 100644 --- /dev/null +++ b/Doc/Data-Ranged.html @@ -0,0 +1,106 @@ + + +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 new file mode 100644 --- /dev/null +++ b/Doc/doc-index.html @@ -0,0 +1,454 @@ + + + (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 new file mode 100644 --- /dev/null +++ b/Doc/index.html @@ -0,0 +1,120 @@ + + +
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/INSTALL.txt b/INSTALL.txt new file mode 100644 --- /dev/null +++ b/INSTALL.txt @@ -0,0 +1,14 @@ +As 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". diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,30 @@ +Copyright (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. diff --git a/README.txt b/README.txt new file mode 100644 --- /dev/null +++ b/README.txt @@ -0,0 +1,119 @@ +Ranged 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 +---------- + +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. diff --git a/Ranged-sets.cabal b/Ranged-sets.cabal new file mode 100644 --- /dev/null +++ b/Ranged-sets.cabal @@ -0,0 +1,17 @@ +Name: Ranged-sets +Version: 0.1.0 +License: BSD3 +License-file: LICENSE.txt +Copyright: Paul Johnson, 2005, 2006, 2007 +Author: Paul Johnson +Homepage: http://ranged-sets.sourceforge.net/ +Maintainer: paul@cogito.org.uk +Stability: beta +Category: Data +Build-Depends: base +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). +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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ + +module Main where + +import Distribution.Simple + +main = defaultMain diff --git a/TODO.txt b/TODO.txt new file mode 100644 --- /dev/null +++ b/TODO.txt @@ -0,0 +1,13 @@ +Things 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. + + +