1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
module Ranges
where
import Data.Set (Set)
import qualified Data.Set as Set
data Ord a => Range a = Single !a | Range !a !a
instance (Ord a, Show a) => Show (Range a) where
show (Single x) = concat ["(", show x, ")"]
show (Range x y) = concat ["(", show x, "–", show y, ")"]
newtype Ord a => Ranges a = Ranges [Range a] deriving Show
-- | A rather hacked-up instance.
-- This is to support fast lookups using 'Data.Set' (see 'toSet').
instance (Ord a) => Eq (Range a) where
(Single x) == (Single y) = x == y
(Single a) == (Range x y) = x <= a && a <= y
(Range x y) == (Single a) = x <= a && a <= y
(Range lx ux) == (Range ly uy) = (lx <= uy && ux >= ly) || (ly <= ux && uy >= lx)
instance (Ord a) => Ord (Range a) where
(Single x) <= (Single y) = x <= y
(Single x) <= (Range y _) = x <= y
(Range _ x) <= (Single y) = x <= y
(Range _ x) <= (Range y _) = x <= y
-- | A range consisting of a single value.
single :: (Ord a) => a -> Range a
single x = Single x
-- | Construct a 'Range' from a lower and upper bound.
range :: (Ord a) => a -> a -> Range a
range l u
| l <= u = Range l u
| otherwise = error "lower bound must be smaller than upper bound"
-- | Construct a 'Ranges' from a list of lower and upper bounds.
ranges :: (Ord a) => [Range a] -> Ranges a
ranges = Ranges . foldr (flip mergeRanges) []
-- | Tests if a given range contains a particular value.
inRange :: (Ord a) => a -> Range a -> Bool
inRange x y = Single x == y
-- | Tests if any of the ranges contains a particular value.
inRanges :: (Ord a) => a -> Ranges a -> Bool
inRanges x (Ranges xs) = or . map (x `inRange`) $ xs
mergeRange :: (Ord a) => Range a -> Range a -> Either (Range a) (Range a)
mergeRange x y =
if x == y
then Right $ minMax x y
else Left $ x
minMax :: (Ord a) => Range a -> Range a -> Range a
minMax (Range lx ux) (Range ly uy) = Range (min lx ly) (max ux uy)
minMax (Single _) y = y
minMax x@(Range _ _) (Single _) = x
-- | Allows quick lookups using ranges.
toSet :: (Ord a) => Ranges a -> Set (Range a)
toSet (Ranges x) = Set.fromList x
addRange :: (Ord a) => Ranges a -> Range a -> Ranges a
addRange (Ranges x) = Ranges . mergeRanges x
mergeRanges :: (Ord a) => [Range a] -> Range a -> [Range a]
mergeRanges [] y = [y]
mergeRanges (x:xs) y = case mergeRange x y of
Right z -> mergeRanges xs z
Left x -> x : (mergeRanges xs y)
|
