1-----------------------------------------------------------------------------
2--
3-- Module      :  Data.Ranged.Ranges
4-- Copyright   :  (c) Paul Johnson 2006
5-- License     :  BSD-style
6-- Maintainer  :  paul@cogito.org.uk
7-- Stability   :  experimental
8-- Portability :  portable
9--
10-----------------------------------------------------------------------------
11
12-- | A range has an upper and lower boundary.
13module Data.Ranged.Ranges (
14   -- ** Construction
15   Range (..),
16   emptyRange,
17   fullRange,
18   -- ** Predicates
19   rangeIsEmpty,
20   rangeIsFull,
21   rangeOverlap,
22   rangeEncloses,
23   rangeSingletonValue,
24   -- ** Membership
25   rangeHas,
26   rangeListHas,
27   -- ** Set Operations
28   singletonRange,
29   rangeIntersection,
30   rangeUnion,
31   rangeDifference,
32) where
33
34import           Data.Ranged.Boundaries
35
36-- | A Range has upper and lower boundaries.
37data Range v = Range {rangeLower, rangeUpper :: Boundary v}
38
39instance (DiscreteOrdered a) => Eq (Range a) where
40   r1 == r2   = (rangeIsEmpty r1 && rangeIsEmpty r2) ||
41                (rangeLower r1 == rangeLower r2 &&
42                 rangeUpper r1 == rangeUpper r2)
43
44
45instance (DiscreteOrdered a) => Ord (Range a) where
46   compare r1 r2
47      | r1 == r2       = EQ
48      | rangeIsEmpty r1  = LT
49      | rangeIsEmpty r2  = GT
50      | otherwise      = compare (rangeLower r1, rangeUpper r1)
51                                 (rangeLower r2, rangeUpper r2)
52
53instance (Show a, DiscreteOrdered a) => Show (Range a) where
54   show r
55      | rangeIsEmpty r     = "Empty"
56      | rangeIsFull r      = "All x"
57      | otherwise          =
58         case rangeSingletonValue r of
59            Just v  -> "x == " ++ show v
60            Nothing -> lowerBound ++ "x" ++ upperBound
61      where
62         lowerBound = case rangeLower r of
63            BoundaryBelowAll -> ""
64            BoundaryBelow v  -> show v ++ " <= "
65            BoundaryAbove v  -> show v ++ " < "
66            BoundaryAboveAll -> error "show Range: lower bound is BoundaryAboveAll"
67         upperBound = case rangeUpper r of
68            BoundaryBelowAll -> error "show Range: upper bound is BoundaryBelowAll"
69            BoundaryBelow v  -> " < " ++ show v
70            BoundaryAbove v  -> " <= " ++ show v
71            BoundaryAboveAll -> ""
72
73
74-- | True if the value is within the range.
75rangeHas :: Ord v => Range v -> v -> Bool
76
77rangeHas (Range b1 b2) v =
78   (v />/ b1) && not (v />/ b2)
79
80
81-- | True if the value is within one of the ranges.
82rangeListHas :: Ord v =>
83   [Range v] -> v -> Bool
84rangeListHas ls v = or $ map (\r -> rangeHas r v) ls
85
86
87-- | The empty range
88emptyRange :: Range v
89emptyRange = Range BoundaryAboveAll BoundaryBelowAll
90
91
92-- | The full range.  All values are within it.
93fullRange :: Range v
94fullRange = Range BoundaryBelowAll BoundaryAboveAll
95
96
97-- | A range containing a single value
98singletonRange :: v -> Range v
99singletonRange v = Range (BoundaryBelow v) (BoundaryAbove v)
100
101
102-- | If the range is a singleton, returns @Just@ the value.  Otherwise returns
103-- @Nothing@.
104--
105-- Known bug: This always returns @Nothing@ for ranges including
106-- @BoundaryBelowAll@ or @BoundaryAboveAll@.  For bounded types this can be
107-- incorrect.  For instance, the following range only contains one value:
108--
109-- >    Range (BoundaryBelow maxBound) BoundaryAboveAll
110rangeSingletonValue :: DiscreteOrdered v => Range v -> Maybe v
111rangeSingletonValue (Range (BoundaryBelow v1) (BoundaryBelow v2))
112   | adjacent v1 v2  = Just v1
113   | otherwise       = Nothing
114rangeSingletonValue (Range (BoundaryBelow v1) (BoundaryAbove v2))
115   | v1 == v2        = Just v1
116   | otherwise       = Nothing
117rangeSingletonValue (Range (BoundaryAbove v1) (BoundaryBelow v2)) =
118   do
119      v2' <- adjacentBelow v2
120      v2'' <- adjacentBelow v2'
121      if v1 == v2'' then return v2' else Nothing
122rangeSingletonValue (Range (BoundaryAbove v1) (BoundaryAbove v2))
123   | adjacent v1 v2  = Just v2
124   | otherwise       = Nothing
125rangeSingletonValue (Range _ _) = Nothing
126
127-- | A range is empty unless its upper boundary is greater than its lower
128-- boundary.
129rangeIsEmpty :: DiscreteOrdered v => Range v -> Bool
130rangeIsEmpty (Range lower upper) = upper <= lower
131
132
133-- | A range is full if it contains every possible value.
134rangeIsFull :: DiscreteOrdered v => Range v -> Bool
135rangeIsFull = (== fullRange)
136
137-- | Two ranges overlap if their intersection is non-empty.
138rangeOverlap :: DiscreteOrdered v => Range v -> Range v -> Bool
139rangeOverlap r1 r2 =
140   not (rangeIsEmpty r1)
141   && not (rangeIsEmpty r2)
142   && not (rangeUpper r1 <= rangeLower r2 || rangeUpper r2 <= rangeLower r1)
143
144
145-- | The first range encloses the second if every value in the second range is
146-- also within the first range.  If the second range is empty then this is
147-- always true.
148rangeEncloses :: DiscreteOrdered v => Range v -> Range v -> Bool
149rangeEncloses r1 r2 =
150   (rangeLower r1 <= rangeLower r2 && rangeUpper r2 <= rangeUpper r1)
151   || rangeIsEmpty r2
152
153
154-- | Intersection of two ranges, if any.
155rangeIntersection :: DiscreteOrdered v => Range v -> Range v -> Range v
156rangeIntersection r1@(Range lower1 upper1) r2@(Range lower2 upper2)
157    | rangeIsEmpty r1 || rangeIsEmpty r2  = emptyRange
158    | otherwise  = Range (max lower1 lower2) (min upper1 upper2)
159
160
161-- | Union of two ranges.  Returns one or two results.
162--
163-- If there are two results then they are guaranteed to have a non-empty
164-- gap in between, but may not be in ascending order.
165rangeUnion :: DiscreteOrdered v => Range v -> Range v -> [Range v]
166rangeUnion r1@(Range lower1 upper1) r2@(Range lower2 upper2)
167   | rangeIsEmpty r1  = [r2]
168   | rangeIsEmpty r2  = [r1]
169   | otherwise =
170       if touching then [Range lower upper] else [r1, r2]
171   where
172     touching = (max lower1 lower2) <= (min upper1 upper2)
173     lower = min lower1 lower2
174     upper = max upper1 upper2
175
176
177-- | @range1@ minus @range2@.  Returns zero, one or two results.  Multiple
178-- results are guaranteed to have non-empty gaps in between, but may not be in
179-- ascending order.
180rangeDifference :: DiscreteOrdered v => Range v -> Range v -> [Range v]
181
182rangeDifference r1@(Range lower1 upper1) (Range lower2 upper2) =
183   -- There are six possibilities
184   --    1: r2 completely less than r1
185   --    2: r2 overlaps bottom of r1
186   --    3: r2 encloses r1
187   --    4: r1 encloses r2
188   --    5: r2 overlaps top of r1
189   --    6: r2 completely greater than r1
190   if intersects
191      then -- Cases 2,3,4,5
192         filter (not . rangeIsEmpty) [Range lower1 lower2, Range upper2 upper1]
193      else -- Cases 1, 6
194         [r1]
195   where
196      intersects = (max lower1 lower2) < (min upper1 upper2)
197