1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Data.Ranged.Boundaries
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
12module Data.Ranged.Boundaries (
13   DiscreteOrdered (..),
14   enumAdjacent,
15   boundedAdjacent,
16   boundedBelow,
17   Boundary (..),
18   above,
19   (/>/)
20) where
21
22import           Data.Ratio
23import           Data.Word
24
25infix 4 />/
26
27{- |
28Distinguish between dense and sparse ordered types.  A dense type is
29one in which any two values @v1 < v2@ have a third value @v3@ such that
30@v1 < v3 < v2@.
31
32In theory the floating types are dense, although in practice they can only have
33finitely many values.  This class treats them as dense.
34
35Tuples up to 4 members are declared as instances.  Larger tuples may be added
36if necessary.
37
38Most values of sparse types have an @adjacentBelow@, such that, for all x:
39
40> case adjacentBelow x of
41>    Just x1 -> adjacent x1 x
42>    Nothing -> True
43
44The exception is for bounded types when @x == lowerBound@.  For dense types
45@adjacentBelow@ always returns 'Nothing'.
46
47This approach was suggested by Ben Rudiak-Gould on comp.lang.functional.
48-}
49
50class Ord a => DiscreteOrdered a where
51   -- | Two values @x@ and @y@ are adjacent if @x < y@ and there does not
52   -- exist a third value between them.  Always @False@ for dense types.
53   adjacent :: a -> a -> Bool
54   -- | The value immediately below the argument, if it can be determined.
55   adjacentBelow :: a -> Maybe a
56
57
58-- Implementation note: the precise rules about unbounded enumerated vs
59-- bounded enumerated types are difficult to express using Haskell 98, so
60-- the prelude types are listed individually here.
61
62instance DiscreteOrdered Bool where
63   adjacent = boundedAdjacent
64   adjacentBelow = boundedBelow
65
66instance DiscreteOrdered Ordering where
67   adjacent = boundedAdjacent
68   adjacentBelow = boundedBelow
69
70instance DiscreteOrdered Char where
71   adjacent = boundedAdjacent
72   adjacentBelow = boundedBelow
73
74instance DiscreteOrdered Int where
75   adjacent = boundedAdjacent
76   adjacentBelow = boundedBelow
77
78instance DiscreteOrdered Integer where
79   adjacent = enumAdjacent
80   adjacentBelow = Just . pred
81
82instance DiscreteOrdered Double where
83   adjacent _ _ = False
84   adjacentBelow = const Nothing
85
86instance DiscreteOrdered Float where
87   adjacent _ _ = False
88   adjacentBelow = const Nothing
89
90instance (Integral a) => DiscreteOrdered (Ratio a) where
91   adjacent _ _ = False
92   adjacentBelow = const Nothing
93
94instance Ord a => DiscreteOrdered [a] where
95   adjacent _ _ = False
96   adjacentBelow = const Nothing
97
98instance (Ord a, DiscreteOrdered b) => DiscreteOrdered (a, b)
99   where
100      adjacent (x1, x2) (y1, y2) = (x1 == y1) && adjacent x2 y2
101      adjacentBelow (x1, x2) = do -- Maybe monad
102         x2' <- adjacentBelow x2
103         return (x1, x2')
104
105instance (Ord a, Ord b, DiscreteOrdered c) => DiscreteOrdered (a, b, c)
106   where
107      adjacent (x1, x2, x3) (y1, y2, y3) =
108         (x1 == y1) && (x2 == y2) && adjacent x3 y3
109      adjacentBelow (x1, x2, x3) = do -- Maybe monad
110         x3' <- adjacentBelow x3
111         return (x1, x2, x3')
112
113instance (Ord a, Ord b, Ord c, DiscreteOrdered d) =>
114         DiscreteOrdered (a, b, c, d)
115   where
116      adjacent (x1, x2, x3, x4) (y1, y2, y3, y4) =
117         (x1 == y1) && (x2 == y2) && (x3 == y3) && adjacent x4 y4
118      adjacentBelow (x1, x2, x3, x4) = do -- Maybe monad
119         x4' <- adjacentBelow x4
120         return (x1, x2, x3, x4')
121
122instance DiscreteOrdered Word8 where
123    adjacent x y = x + 1 == y
124    adjacentBelow 0 = Nothing
125    adjacentBelow x = Just (x-1)
126
127
128-- | Check adjacency for sparse enumerated types (i.e. where there
129-- is no value between @x@ and @succ x@).
130enumAdjacent :: (Ord a, Enum a) => a -> a -> Bool
131enumAdjacent x y = (succ x == y)
132
133-- | Check adjacency, allowing for case where x = maxBound.  Use as the
134-- definition of "adjacent" for bounded enumerated types such as Int and Char.
135boundedAdjacent :: (Ord a, Enum a) => a -> a -> Bool
136boundedAdjacent x y = if x < y then succ x == y else False
137
138
139-- | The usual implementation of 'adjacentBelow' for bounded enumerated types.
140boundedBelow :: (Eq a, Enum a, Bounded a) => a -> Maybe a
141boundedBelow x = if x == minBound then Nothing else Just $ pred x
142
143{- |
144A Boundary is a division of an ordered type into values above
145and below the boundary.  No value can sit on a boundary.
146
147Known bug: for Bounded types
148
149* @BoundaryAbove maxBound < BoundaryAboveAll@
150
151* @BoundaryBelow minBound > BoundaryBelowAll@
152
153This is incorrect because there are no possible values in
154between the left and right sides of these inequalities.
155-}
156
157data Boundary a =
158      -- | The argument is the highest value below the boundary.
159      BoundaryAbove a |
160      -- | The argument is the lowest value above the boundary.
161      BoundaryBelow a |
162      -- | The boundary above all values.
163      BoundaryAboveAll |
164      -- | The boundary below all values.
165      BoundaryBelowAll
166   deriving (Show)
167
168-- | True if the value is above the boundary, false otherwise.
169above :: Ord v => Boundary v -> v -> Bool
170above (BoundaryAbove b) v = v > b
171above (BoundaryBelow b) v = v >= b
172above BoundaryAboveAll _  = False
173above BoundaryBelowAll _  = True
174
175-- | Same as 'above', but with the arguments reversed for more intuitive infix
176-- usage.
177(/>/) :: Ord v => v -> Boundary v -> Bool
178(/>/) = flip above
179
180instance (DiscreteOrdered a) => Eq (Boundary a) where
181   b1 == b2  = compare b1 b2 == EQ
182
183instance (DiscreteOrdered a) => Ord (Boundary a) where
184   -- Comparison alogrithm based on brute force and ignorance:
185   -- enumerate all combinations.
186
187   compare boundary1 boundary2 =
188      case boundary1 of
189         BoundaryAbove b1 ->
190            case boundary2 of
191               BoundaryAbove b2 -> compare b1 b2
192               BoundaryBelow b2 ->
193                  if b1 < b2
194                     then
195                        if adjacent b1 b2 then EQ else LT
196                     else GT
197               BoundaryAboveAll -> LT
198               BoundaryBelowAll -> GT
199         BoundaryBelow b1 ->
200            case boundary2 of
201               BoundaryAbove b2 ->
202                  if b1 > b2
203                     then
204                        if adjacent b2 b1 then EQ else GT
205                     else LT
206               BoundaryBelow b2 -> compare b1 b2
207               BoundaryAboveAll -> LT
208               BoundaryBelowAll -> GT
209         BoundaryAboveAll ->
210            case boundary2 of
211               BoundaryAboveAll -> EQ
212               _                -> GT
213         BoundaryBelowAll ->
214            case boundary2 of
215               BoundaryBelowAll -> EQ
216               _                -> LT
217