msakai / data-interval / 101

Committed 20 Jan 2026 11:20PM UTC coverage: 87.081% (+0.3%) from 86.789%

Build # 101

Build Type

push

github

Committed by

Bodigrim

Commit Message

Restrict and delete interval keys for Data.Map and Data.Set

Run Details

80 of 85 new or added lines in 2 files covered. (94.12%)

4 existing lines in 2 files now uncovered.

1065 of 1223 relevant lines covered (87.08%)

0.87 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

90.45

/src/Data/Interval/Internal.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE RoleAnnotations #-}

module Data.Interval.Internal
  ( Boundary(..)
  , Interval
  , lowerBound'
  , upperBound'
  , interval
  , empty
  , restrictMapKeysToInterval
  , withoutMapKeysFromInterval
  , intersectionSetAndInterval
  , differenceSetAndInterval
  ) where

import Control.DeepSeq
import Data.Data
import Data.ExtendedReal
import Data.Hashable
import Data.Int
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import GHC.Generics (Generic)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)

-- | Boundary of an interval may be
-- open (excluding an endpoint) or closed (including an endpoint).
--
-- @since 2.0.0
data Boundary
  = Open
  | Closed
  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data)

instance NFData Boundary

instance Hashable Boundary

-- | The intervals (/i.e./ connected and convex subsets) over a type @r@.
data Interval r
  = Whole
  | Empty
  | Point !r
  | LessThan !r
  | LessOrEqual !r
  | GreaterThan !r
  | GreaterOrEqual !r
  -- For constructors below
  -- the first argument is strictly less than the second one
  | BothClosed !r !r
  | LeftOpen !r !r
  | RightOpen !r !r
  | BothOpen !r !r
  deriving
    ( Eq
    , Ord
      -- ^ Note that this Ord is derived and not semantically meaningful.
      -- The primary intended use case is to allow using 'Interval'
      -- in maps and sets that require ordering.
    )

peekInterval :: (Applicative m, Monad m, Ord r) => m Int8 -> m r -> m r -> m (Interval r)
peekInterval tagM x y = do
  tag <- tagM
  case tag of
    0 -> pure Whole
    1 -> pure Empty
    2 -> Point           <$> x
    3 -> LessThan        <$> x
    4 -> LessOrEqual     <$> x
    5 -> GreaterThan     <$> x
    6 -> GreaterOrEqual  <$> x
    7 -> wrap BothClosed <$> x <*> y
    8 -> wrap LeftOpen   <$> x <*> y
    9 -> wrap RightOpen  <$> x <*> y
    _ -> wrap BothOpen   <$> x <*> y

-- | Enforce the internal invariant
-- of 'BothClosed' / 'LeftOpen' / 'RightOpen' / 'BothOpen'.
wrap :: Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap f x y
  | x < y = f x y
  | otherwise = Empty

pokeInterval :: Applicative m => (Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
pokeInterval tag actX actY = \case
  Whole            -> tag (0 :: Int8)
  Empty            -> tag (1 :: Int8)
  Point          x -> tag (2 :: Int8) *> actX x
  LessThan       x -> tag (3 :: Int8) *> actX x
  LessOrEqual    x -> tag (4 :: Int8) *> actX x
  GreaterThan    x -> tag (5 :: Int8) *> actX x
  GreaterOrEqual x -> tag (6 :: Int8) *> actX x
  BothClosed   x y -> tag (7 :: Int8) *> actX x *> actY y
  LeftOpen     x y -> tag (8 :: Int8) *> actX x *> actY y
  RightOpen    x y -> tag (9 :: Int8) *> actX x *> actY y
  BothOpen     x y -> tag (10 :: Int8) *> actX x *> actY y

instance (Storable r, Ord r) => Storable (Interval r) where
  sizeOf _ = 3 * sizeOf (undefined :: r)
  alignment _ = alignment (undefined :: r)
  peek ptr = peekInterval
    (peek $ castPtr ptr)
    (peek $ castPtr ptr `advancePtr` 1)
    (peek $ castPtr ptr `advancePtr` 2)
  poke ptr = pokeInterval
    (poke $ castPtr ptr)
    (poke $ castPtr ptr `advancePtr` 1)
    (poke $ castPtr ptr `advancePtr` 2)

-- | Lower endpoint (/i.e./ greatest lower bound) of the interval,
-- together with 'Boundary' information.
-- The result is convenient to use as an argument for 'interval'.
lowerBound' :: Interval r -> (Extended r, Boundary)
lowerBound' = \case
  Whole            -> (NegInf,   Open)
  Empty            -> (PosInf,   Open)
  Point r          -> (Finite r, Closed)
  LessThan{}       -> (NegInf,   Open)
  LessOrEqual{}    -> (NegInf,   Open)
  GreaterThan r    -> (Finite r, Open)
  GreaterOrEqual r -> (Finite r, Closed)
  BothClosed p _   -> (Finite p, Closed)
  LeftOpen p _     -> (Finite p, Open)
  RightOpen p _    -> (Finite p, Closed)
  BothOpen p _     -> (Finite p, Open)

-- | Upper endpoint (/i.e./ least upper bound) of the interval,
-- together with 'Boundary' information.
-- The result is convenient to use as an argument for 'interval'.
upperBound' :: Interval r -> (Extended r, Boundary)
upperBound' = \case
  Whole            -> (PosInf,   Open)
  Empty            -> (NegInf,   Open)
  Point r          -> (Finite r, Closed)
  LessThan r       -> (Finite r, Open)
  LessOrEqual r    -> (Finite r, Closed)
  GreaterThan{}    -> (PosInf,   Open)
  GreaterOrEqual{} -> (PosInf,   Open)
  BothClosed _ q   -> (Finite q, Closed)
  LeftOpen _ q     -> (Finite q, Closed)
  RightOpen _ q    -> (Finite q, Open)
  BothOpen _ q     -> (Finite q, Open)

type role Interval nominal

instance (Ord r, Data r) => Data (Interval r) where
  gfoldl k z x   = z interval `k` lowerBound' x `k` upperBound' x
  toConstr _     = intervalConstr
  gunfold k z c  = case constrIndex c of
    1 -> k (k (z interval))
    _ -> error "gunfold"
  dataTypeOf _   = intervalDataType
  dataCast1 f    = gcast1 f

intervalConstr :: Constr
intervalConstr = mkConstr intervalDataType "interval" [] Prefix

intervalDataType :: DataType
intervalDataType = mkDataType "Data.Interval.Internal.Interval" [intervalConstr]

instance NFData r => NFData (Interval r) where
  rnf = \case
    Whole            -> ()
    Empty            -> ()
    Point r          -> rnf r
    LessThan r       -> rnf r
    LessOrEqual r    -> rnf r
    GreaterThan r    -> rnf r
    GreaterOrEqual r -> rnf r
    BothClosed p q   -> rnf p `seq` rnf q
    LeftOpen p q     -> rnf p `seq` rnf q
    RightOpen p q    -> rnf p `seq` rnf q
    BothOpen p q     -> rnf p `seq` rnf q

instance Hashable r => Hashable (Interval r) where
  hashWithSalt s = \case
    Whole            -> s `hashWithSalt`  (1 :: Int)
    Empty            -> s `hashWithSalt`  (2 :: Int)
    Point r          -> s `hashWithSalt`  (3 :: Int) `hashWithSalt` r
    LessThan r       -> s `hashWithSalt`  (4 :: Int) `hashWithSalt` r
    LessOrEqual r    -> s `hashWithSalt`  (5 :: Int) `hashWithSalt` r
    GreaterThan r    -> s `hashWithSalt`  (6 :: Int) `hashWithSalt` r
    GreaterOrEqual r -> s `hashWithSalt`  (7 :: Int) `hashWithSalt` r
    BothClosed p q   -> s `hashWithSalt`  (8 :: Int) `hashWithSalt` p `hashWithSalt` q
    LeftOpen p q     -> s `hashWithSalt`  (9 :: Int) `hashWithSalt` p `hashWithSalt` q
    RightOpen p q    -> s `hashWithSalt` (10 :: Int) `hashWithSalt` p `hashWithSalt` q
    BothOpen p q     -> s `hashWithSalt` (11 :: Int) `hashWithSalt` p `hashWithSalt` q

-- | empty (contradicting) interval
empty :: Ord r => Interval r
empty = Empty

-- | smart constructor for 'Interval'
interval
  :: (Ord r)
  => (Extended r, Boundary) -- ^ lower bound and whether it is included
  -> (Extended r, Boundary) -- ^ upper bound and whether it is included
  -> Interval r
interval = \case
  (NegInf, _) -> \case
    (NegInf, _) -> Empty
    (Finite r, Open) -> LessThan r
    (Finite r, Closed) -> LessOrEqual r
    (PosInf, _) -> Whole
  (Finite p, Open) -> \case
    (NegInf, _) -> Empty
    (Finite q, Open)
      | p < q -> BothOpen p q
      | otherwise -> Empty
    (Finite q, Closed)
      | p < q -> LeftOpen p q
      | otherwise -> Empty
    (PosInf, _) -> GreaterThan p
  (Finite p, Closed) -> \case
    (NegInf, _) -> Empty
    (Finite q, Open)
      | p < q -> RightOpen p q
      | otherwise -> Empty
    (Finite q, Closed) -> case p `compare` q of
      LT -> BothClosed p q
      EQ -> Point p
      GT -> Empty
    (PosInf, _) -> GreaterOrEqual p
  (PosInf, _) -> const Empty
{-# INLINE interval #-}

-- | \(O(\log n)\). Restrict a 'Map' to the keys contained in a given
-- 'Interval'.
--
-- >>> restrictMapKeysToInterval m i == filterKeys (\k -> Interval.member k i) m
--
-- [Usage:]
--
-- >>> m = Map.fromList [(-2.5,0),(3.1,1),(5,2), (8.5,3)] :: Map Rational Int
-- >>> restrictMapKeysToInterval m (3 <=..< 8.5)
-- fromList [(31 % 10,1),(5 % 1,2)]
--
-- [Performance:]
-- This outperforms 'filterKeys' which is \(O(n)\).
--
restrictMapKeysToInterval :: Ord k => Map k a -> Interval k -> Map k a
restrictMapKeysToInterval m = \case
  Whole -> m
  Empty -> Map.empty
  Point k -> maybe Map.empty (Map.singleton k) (Map.lookup k m)
  LessThan k -> Map.takeWhileAntitone (< k) m
  LessOrEqual k -> Map.takeWhileAntitone (<= k) m
  GreaterThan k -> Map.dropWhileAntitone (<= k) m
  GreaterOrEqual k -> Map.dropWhileAntitone (< k) m
  BothClosed lk uk ->
    Map.takeWhileAntitone (<= uk) $ Map.dropWhileAntitone (< lk) m
  LeftOpen lk uk ->
    Map.takeWhileAntitone (<= uk) $ Map.dropWhileAntitone (<= lk) m
  RightOpen lk uk ->
    Map.takeWhileAntitone (< uk) $ Map.dropWhileAntitone (< lk) m
  BothOpen lk uk ->
    Map.takeWhileAntitone (< uk) $ Map.dropWhileAntitone (<= lk) m
{-# INLINE restrictMapKeysToInterval #-}

-- | \(O(n)\). Delete keys contained in a given 'Interval' from a 'Map'.
--
-- >>> withoutMapKeysFromInterval i m == filterKeys (\k -> Interval.notMember k i) m
--
-- [Usage:]
--
-- >>> m = Map.fromList [(-2.5,0),(3.1,1),(5,2), (8.5,3)] :: Map Rational Int
-- >>> withoutMapKeysFromInterval (3 <=..< 8.5) m
-- fromList [((-5) % 2,0),(17 % 2,3)]
--
-- [Performance:] In practice, this outperforms 'filterKeys'.
--
withoutMapKeysFromInterval :: Ord k => Interval k -> Map k a -> Map k a
withoutMapKeysFromInterval i m = case i of
  Whole -> Map.empty
  Empty -> m
  Point k -> Map.delete k m
  LessThan k -> restrictMapKeysToInterval m (GreaterOrEqual k)
  LessOrEqual k -> restrictMapKeysToInterval m (GreaterThan k)
  GreaterThan k -> restrictMapKeysToInterval m (LessOrEqual k)
  GreaterOrEqual k -> restrictMapKeysToInterval m (LessThan k)
  BothClosed lk uk -> let (lt,_,gt) = Map.splitLookup uk m in
    restrictMapKeysToInterval lt (LessThan lk) `Map.union` gt
  LeftOpen lk uk -> let (lt,_,gt) = Map.splitLookup uk m in
    restrictMapKeysToInterval lt (LessOrEqual lk) `Map.union` gt
  RightOpen lk uk -> let (lt,_,gt) = Map.splitLookup lk m in
    lt `Map.union` restrictMapKeysToInterval gt (GreaterOrEqual uk)
  BothOpen lk uk ->
    restrictMapKeysToInterval m (LessOrEqual lk)
    `Map.union` restrictMapKeysToInterval m (GreaterOrEqual uk)
{-# INLINE withoutMapKeysFromInterval #-}

------------------------------------------------------------------------------

-- | \(O(\log n)\). Restrict a 'Set' to the keys contained in a given
-- 'Interval'.
--
-- >>> intersectionSetAndInterval s i == Set.filter (\k -> Interval.member k i) s
--
-- [Usage:]
--
-- >>> s = Set.fromList [-2.5, 3.1, 5 , 8.5] :: Set Rational
-- >>> intersectionSetAndInterval s (3 <=..< 8.5)
-- fromList [31 % 10,5 % 1]
--
-- [Performance:] This outperforms 'Set.filter' which is \(O(n)\).
--
intersectionSetAndInterval :: Ord k => Set k -> Interval k -> Set k
intersectionSetAndInterval s = \case
  Whole -> s
  Empty -> Set.empty
  Point k -> if Set.member k s then Set.singleton k else Set.empty
  LessThan k -> Set.takeWhileAntitone (< k) s
  LessOrEqual k -> Set.takeWhileAntitone (<= k) s
  GreaterThan k -> Set.dropWhileAntitone (<= k) s
  GreaterOrEqual k -> Set.dropWhileAntitone (< k) s
  BothClosed lk uk ->
    Set.takeWhileAntitone (<= uk) $ Set.dropWhileAntitone (< lk) s
  LeftOpen lk uk ->
    Set.takeWhileAntitone (<= uk) $ Set.dropWhileAntitone (<= lk) s
  RightOpen lk uk ->
    Set.takeWhileAntitone (< uk) $ Set.dropWhileAntitone (< lk) s
  BothOpen lk uk ->
    Set.takeWhileAntitone (< uk) $ Set.dropWhileAntitone (<= lk) s
{-# INLINE intersectionSetAndInterval #-}

-- | \(O(n)\). Delete keys contained in a given 'Interval' from a 'Set'.
--
-- >>> differenceSetAndInterval i s == Set.filter (\k -> Interval.notMember k i) s
--
-- [Usage:]
--
-- >>> s = Set.fromList [-2.5, 3.1, 5 , 8.5] :: Set Rational
-- >>> differenceSetAndInterval s (3 <=..< 8.5)
-- fromList [(-5) % 2,17 % 2]
--
-- [Performance:] In practice, this outperforms 'Set.filter'.
--
differenceSetAndInterval :: Ord k => Set k -> Interval k -> Set k
differenceSetAndInterval s i = case i of
  Whole -> Set.empty
  Empty -> s
  Point k -> Set.delete k s
  LessThan k -> intersectionSetAndInterval s (GreaterOrEqual k)
  LessOrEqual k -> intersectionSetAndInterval s (GreaterThan k)
  GreaterThan k -> intersectionSetAndInterval s (LessOrEqual k)
  GreaterOrEqual k -> intersectionSetAndInterval s (LessThan k)
  BothClosed lk uk -> let (lt,_,gt) = Set.splitMember uk s in
    Set.takeWhileAntitone (< lk) lt `Set.union` gt
  LeftOpen lk uk -> let (lt,_,gt) = Set.splitMember uk s in
    Set.takeWhileAntitone (<= lk) lt `Set.union` gt
  RightOpen lk uk -> let (lt,_,gt) = Set.splitMember lk s in
    lt `Set.union` Set.dropWhileAntitone (< uk) gt
  BothOpen lk uk ->
    Set.takeWhileAntitone (<= lk) s `Set.union` Set.dropWhileAntitone (< uk) s
{-# INLINE differenceSetAndInterval #-}

1	{-# OPTIONS_GHC -Wall #-}
2	{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-}
3	{-# LANGUAGE Safe #-}
4	{-# LANGUAGE RoleAnnotations #-}
5
6	module Data.Interval.Internal
7	( Boundary(..)
8	, Interval
9	, lowerBound'
10	, upperBound'
11	, interval
12	, empty
13	, restrictMapKeysToInterval
14	, withoutMapKeysFromInterval
15	, intersectionSetAndInterval
16	, differenceSetAndInterval
17	) where
18
19	import Control.DeepSeq
20	import Data.Data
21	import Data.ExtendedReal
22	import Data.Hashable
23	import Data.Int
24	import Foreign.Marshal.Array
25	import Foreign.Ptr
26	import Foreign.Storable
27	import GHC.Generics (Generic)
28	import qualified Data.Map as Map
29	import Data.Map (Map)
30	import qualified Data.Set as Set
31	import Data.Set (Set)
32
33	-- \| Boundary of an interval may be
34	-- open (excluding an endpoint) or closed (including an endpoint).
35	--
36	-- @since 2.0.0
37	data Boundary
38	= Open
39	\| Closed
40	deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data)	×
41
42	instance NFData Boundary
43
44	instance Hashable Boundary
45
46	-- \| The intervals (/i.e./ connected and convex subsets) over a type @r@.
47	data Interval r
48	= Whole
49	\| Empty
50	\| Point !r
51	\| LessThan !r
52	\| LessOrEqual !r
53	\| GreaterThan !r
54	\| GreaterOrEqual !r
55	-- For constructors below
56	-- the first argument is strictly less than the second one
57	\| BothClosed !r !r
58	\| LeftOpen !r !r
59	\| RightOpen !r !r
60	\| BothOpen !r !r
61	deriving
62	( Eq	1✔
63	, Ord	×
64	-- ^ Note that this Ord is derived and not semantically meaningful.
65	-- The primary intended use case is to allow using 'Interval'
66	-- in maps and sets that require ordering.
67	)
68
69	peekInterval :: (Applicative m, Monad m, Ord r) => m Int8 -> m r -> m r -> m (Interval r)
70	peekInterval tagM x y = do	1✔
71	tag <- tagM	1✔
72	case tag of	1✔
73	0 -> pure Whole	1✔
74	1 -> pure Empty	1✔
75	2 -> Point <$> x	1✔
76	3 -> LessThan <$> x	1✔
77	4 -> LessOrEqual <$> x	1✔
78	5 -> GreaterThan <$> x	1✔
79	6 -> GreaterOrEqual <$> x	1✔
80	7 -> wrap BothClosed <$> x <*> y	1✔
81	8 -> wrap LeftOpen <$> x <*> y	1✔
82	9 -> wrap RightOpen <$> x <*> y	1✔
83	_ -> wrap BothOpen <$> x <*> y	1✔
84
85	-- \| Enforce the internal invariant
86	-- of 'BothClosed' / 'LeftOpen' / 'RightOpen' / 'BothOpen'.
87	wrap :: Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
88	wrap f x y	1✔
89	\| x < y = f x y	×
90	\| otherwise = Empty	×
91
92	pokeInterval :: Applicative m => (Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
93	pokeInterval tag actX actY = \case	1✔
94	Whole -> tag (0 :: Int8)	1✔
95	Empty -> tag (1 :: Int8)	1✔
96	Point x -> tag (2 :: Int8) *> actX x	1✔
97	LessThan x -> tag (3 :: Int8) *> actX x	1✔
98	LessOrEqual x -> tag (4 :: Int8) *> actX x	1✔
99	GreaterThan x -> tag (5 :: Int8) *> actX x	1✔
100	GreaterOrEqual x -> tag (6 :: Int8) *> actX x	1✔
101	BothClosed x y -> tag (7 :: Int8) > actX x > actY y	1✔
102	LeftOpen x y -> tag (8 :: Int8) > actX x > actY y	1✔
103	RightOpen x y -> tag (9 :: Int8) > actX x > actY y	1✔
104	BothOpen x y -> tag (10 :: Int8) > actX x > actY y	1✔
105
106	instance (Storable r, Ord r) => Storable (Interval r) where
107	sizeOf _ = 3 * sizeOf (undefined :: r)	×
108	alignment _ = alignment (undefined :: r)	×
109	peek ptr = peekInterval	1✔
110	(peek $ castPtr ptr)	1✔
111	(peek $ castPtr ptr `advancePtr` 1)	1✔
112	(peek $ castPtr ptr `advancePtr` 2)	1✔
113	poke ptr = pokeInterval	1✔
114	(poke $ castPtr ptr)	1✔
115	(poke $ castPtr ptr `advancePtr` 1)	1✔
116	(poke $ castPtr ptr `advancePtr` 2)	1✔
117
118	-- \| Lower endpoint (/i.e./ greatest lower bound) of the interval,
119	-- together with 'Boundary' information.
120	-- The result is convenient to use as an argument for 'interval'.
121	lowerBound' :: Interval r -> (Extended r, Boundary)
122	lowerBound' = \case	1✔
123	Whole -> (NegInf, Open)	1✔
124	Empty -> (PosInf, Open)	1✔
125	Point r -> (Finite r, Closed)	1✔
126	LessThan{} -> (NegInf, Open)	1✔
127	LessOrEqual{} -> (NegInf, Open)	1✔
128	GreaterThan r -> (Finite r, Open)	1✔
129	GreaterOrEqual r -> (Finite r, Closed)	1✔
130	BothClosed p _ -> (Finite p, Closed)	1✔
131	LeftOpen p _ -> (Finite p, Open)	1✔
132	RightOpen p _ -> (Finite p, Closed)	1✔
133	BothOpen p _ -> (Finite p, Open)	1✔
134
135	-- \| Upper endpoint (/i.e./ least upper bound) of the interval,
136	-- together with 'Boundary' information.
137	-- The result is convenient to use as an argument for 'interval'.
138	upperBound' :: Interval r -> (Extended r, Boundary)
139	upperBound' = \case	1✔
140	Whole -> (PosInf, Open)	1✔
141	Empty -> (NegInf, Open)	1✔
142	Point r -> (Finite r, Closed)	1✔
143	LessThan r -> (Finite r, Open)	1✔
144	LessOrEqual r -> (Finite r, Closed)	1✔
145	GreaterThan{} -> (PosInf, Open)	1✔
146	GreaterOrEqual{} -> (PosInf, Open)	1✔
147	BothClosed _ q -> (Finite q, Closed)	1✔
148	LeftOpen _ q -> (Finite q, Closed)	1✔
149	RightOpen _ q -> (Finite q, Open)	1✔
150	BothOpen _ q -> (Finite q, Open)	1✔
151
152	type role Interval nominal
153
154	instance (Ord r, Data r) => Data (Interval r) where
155	gfoldl k z x = z interval `k` lowerBound' x `k` upperBound' x	1✔
156	toConstr _ = intervalConstr	×
157	gunfold k z c = case constrIndex c of	×
158	1 -> k (k (z interval))	×
159	_ -> error "gunfold"	×
160	dataTypeOf _ = intervalDataType	×
161	dataCast1 f = gcast1 f	×
162
163	intervalConstr :: Constr
164	intervalConstr = mkConstr intervalDataType "interval" [] Prefix	×
165
166	intervalDataType :: DataType
167	intervalDataType = mkDataType "Data.Interval.Internal.Interval" [intervalConstr]	×
168
169	instance NFData r => NFData (Interval r) where
170	rnf = \case	1✔
171	Whole -> ()	1✔
172	Empty -> ()	1✔
173	Point r -> rnf r	1✔
174	LessThan r -> rnf r	1✔
175	LessOrEqual r -> rnf r	1✔
176	GreaterThan r -> rnf r	1✔
177	GreaterOrEqual r -> rnf r	1✔
178	BothClosed p q -> rnf p `seq` rnf q	1✔
179	LeftOpen p q -> rnf p `seq` rnf q	1✔
180	RightOpen p q -> rnf p `seq` rnf q	1✔
181	BothOpen p q -> rnf p `seq` rnf q	1✔
182
183	instance Hashable r => Hashable (Interval r) where
184	hashWithSalt s = \case	1✔
185	Whole -> s `hashWithSalt` (1 :: Int)	1✔
186	Empty -> s `hashWithSalt` (2 :: Int)	1✔
187	Point r -> s `hashWithSalt` (3 :: Int) `hashWithSalt` r	1✔
188	LessThan r -> s `hashWithSalt` (4 :: Int) `hashWithSalt` r	1✔
189	LessOrEqual r -> s `hashWithSalt` (5 :: Int) `hashWithSalt` r	1✔
190	GreaterThan r -> s `hashWithSalt` (6 :: Int) `hashWithSalt` r	1✔
191	GreaterOrEqual r -> s `hashWithSalt` (7 :: Int) `hashWithSalt` r	1✔
192	BothClosed p q -> s `hashWithSalt` (8 :: Int) `hashWithSalt` p `hashWithSalt` q	1✔
193	LeftOpen p q -> s `hashWithSalt` (9 :: Int) `hashWithSalt` p `hashWithSalt` q	1✔
194	RightOpen p q -> s `hashWithSalt` (10 :: Int) `hashWithSalt` p `hashWithSalt` q	1✔
195	BothOpen p q -> s `hashWithSalt` (11 :: Int) `hashWithSalt` p `hashWithSalt` q	1✔
196
197	-- \| empty (contradicting) interval
198	empty :: Ord r => Interval r
199	empty = Empty	1✔
200
201	-- \| smart constructor for 'Interval'
202	interval
203	:: (Ord r)
204	=> (Extended r, Boundary) -- ^ lower bound and whether it is included
205	-> (Extended r, Boundary) -- ^ upper bound and whether it is included
206	-> Interval r
207	interval = \case	1✔
208	(NegInf, _) -> \case	1✔
209	(NegInf, _) -> Empty	1✔
210	(Finite r, Open) -> LessThan r	1✔
211	(Finite r, Closed) -> LessOrEqual r	1✔
212	(PosInf, _) -> Whole	1✔
213	(Finite p, Open) -> \case	1✔
214	(NegInf, _) -> Empty	1✔
215	(Finite q, Open)
216	\| p < q -> BothOpen p q	1✔
217	\| otherwise -> Empty	1✔
218	(Finite q, Closed)
219	\| p < q -> LeftOpen p q	1✔
220	\| otherwise -> Empty	1✔
221	(PosInf, _) -> GreaterThan p	1✔
222	(Finite p, Closed) -> \case	1✔
223	(NegInf, _) -> Empty	1✔
224	(Finite q, Open)
225	\| p < q -> RightOpen p q	1✔
226	\| otherwise -> Empty	1✔
227	(Finite q, Closed) -> case p `compare` q of	1✔
228	LT -> BothClosed p q	1✔
229	EQ -> Point p	1✔
230	GT -> Empty	1✔
231	(PosInf, _) -> GreaterOrEqual p	1✔
232	(PosInf, _) -> const Empty	1✔
233	{-# INLINE interval #-}
234
235	-- \| \(O(\log n)\). Restrict a 'Map' to the keys contained in a given
236	-- 'Interval'.
237	--
238	-- >>> restrictMapKeysToInterval m i == filterKeys (\k -> Interval.member k i) m
239	--
240	-- [Usage:]
241	--
242	-- >>> m = Map.fromList [(-2.5,0),(3.1,1),(5,2), (8.5,3)] :: Map Rational Int
243	-- >>> restrictMapKeysToInterval m (3 <=..< 8.5)
244	-- fromList [(31 % 10,1),(5 % 1,2)]
245	--
246	-- [Performance:]
247	-- This outperforms 'filterKeys' which is \(O(n)\).
248	--
249	restrictMapKeysToInterval :: Ord k => Map k a -> Interval k -> Map k a
250	restrictMapKeysToInterval m = \case	1✔
251	Whole -> m	1✔
252	Empty -> Map.empty	1✔
NEW 253	Point k -> maybe Map.empty (Map.singleton k) (Map.lookup k m)	×
254	LessThan k -> Map.takeWhileAntitone (< k) m	1✔
255	LessOrEqual k -> Map.takeWhileAntitone (<= k) m	1✔
256	GreaterThan k -> Map.dropWhileAntitone (<= k) m	1✔
257	GreaterOrEqual k -> Map.dropWhileAntitone (< k) m	1✔
258	BothClosed lk uk ->
259	Map.takeWhileAntitone (<= uk) $ Map.dropWhileAntitone (< lk) m	1✔
260	LeftOpen lk uk ->
261	Map.takeWhileAntitone (<= uk) $ Map.dropWhileAntitone (<= lk) m	1✔
262	RightOpen lk uk ->
263	Map.takeWhileAntitone (< uk) $ Map.dropWhileAntitone (< lk) m	1✔
264	BothOpen lk uk ->
265	Map.takeWhileAntitone (< uk) $ Map.dropWhileAntitone (<= lk) m	1✔
266	{-# INLINE restrictMapKeysToInterval #-}
267
268	-- \| \(O(n)\). Delete keys contained in a given 'Interval' from a 'Map'.
269	--
270	-- >>> withoutMapKeysFromInterval i m == filterKeys (\k -> Interval.notMember k i) m
271	--
272	-- [Usage:]
273	--
274	-- >>> m = Map.fromList [(-2.5,0),(3.1,1),(5,2), (8.5,3)] :: Map Rational Int
275	-- >>> withoutMapKeysFromInterval (3 <=..< 8.5) m
276	-- fromList [((-5) % 2,0),(17 % 2,3)]
277	--
278	-- [Performance:] In practice, this outperforms 'filterKeys'.
279	--
280	withoutMapKeysFromInterval :: Ord k => Interval k -> Map k a -> Map k a
281	withoutMapKeysFromInterval i m = case i of	1✔
282	Whole -> Map.empty	1✔
283	Empty -> m	1✔
284	Point k -> Map.delete k m	1✔
285	LessThan k -> restrictMapKeysToInterval m (GreaterOrEqual k)	1✔
286	LessOrEqual k -> restrictMapKeysToInterval m (GreaterThan k)	1✔
287	GreaterThan k -> restrictMapKeysToInterval m (LessOrEqual k)	1✔
288	GreaterOrEqual k -> restrictMapKeysToInterval m (LessThan k)	1✔
289	BothClosed lk uk -> let (lt,_,gt) = Map.splitLookup uk m in	1✔
290	restrictMapKeysToInterval lt (LessThan lk) `Map.union` gt	1✔
291	LeftOpen lk uk -> let (lt,_,gt) = Map.splitLookup uk m in	1✔
292	restrictMapKeysToInterval lt (LessOrEqual lk) `Map.union` gt	1✔
293	RightOpen lk uk -> let (lt,_,gt) = Map.splitLookup lk m in	1✔
294	lt `Map.union` restrictMapKeysToInterval gt (GreaterOrEqual uk)	1✔
295	BothOpen lk uk ->
296	restrictMapKeysToInterval m (LessOrEqual lk)	1✔
297	`Map.union` restrictMapKeysToInterval m (GreaterOrEqual uk)	1✔
298	{-# INLINE withoutMapKeysFromInterval #-}
299
300	------------------------------------------------------------------------------
301
302	-- \| \(O(\log n)\). Restrict a 'Set' to the keys contained in a given
303	-- 'Interval'.
304	--
305	-- >>> intersectionSetAndInterval s i == Set.filter (\k -> Interval.member k i) s
306	--
307	-- [Usage:]
308	--
309	-- >>> s = Set.fromList [-2.5, 3.1, 5 , 8.5] :: Set Rational
310	-- >>> intersectionSetAndInterval s (3 <=..< 8.5)
311	-- fromList [31 % 10,5 % 1]
312	--
313	-- [Performance:] This outperforms 'Set.filter' which is \(O(n)\).
314	--
315	intersectionSetAndInterval :: Ord k => Set k -> Interval k -> Set k
316	intersectionSetAndInterval s = \case	1✔
317	Whole -> s	1✔
318	Empty -> Set.empty	1✔
NEW 319	Point k -> if Set.member k s then Set.singleton k else Set.empty	×
320	LessThan k -> Set.takeWhileAntitone (< k) s	1✔
321	LessOrEqual k -> Set.takeWhileAntitone (<= k) s	1✔
322	GreaterThan k -> Set.dropWhileAntitone (<= k) s	1✔
323	GreaterOrEqual k -> Set.dropWhileAntitone (< k) s	1✔
324	BothClosed lk uk ->
325	Set.takeWhileAntitone (<= uk) $ Set.dropWhileAntitone (< lk) s	1✔
326	LeftOpen lk uk ->
327	Set.takeWhileAntitone (<= uk) $ Set.dropWhileAntitone (<= lk) s	1✔
328	RightOpen lk uk ->
329	Set.takeWhileAntitone (< uk) $ Set.dropWhileAntitone (< lk) s	1✔
330	BothOpen lk uk ->
331	Set.takeWhileAntitone (< uk) $ Set.dropWhileAntitone (<= lk) s	1✔
332	{-# INLINE intersectionSetAndInterval #-}
333
334	-- \| \(O(n)\). Delete keys contained in a given 'Interval' from a 'Set'.
335	--
336	-- >>> differenceSetAndInterval i s == Set.filter (\k -> Interval.notMember k i) s
337	--
338	-- [Usage:]
339	--
340	-- >>> s = Set.fromList [-2.5, 3.1, 5 , 8.5] :: Set Rational
341	-- >>> differenceSetAndInterval s (3 <=..< 8.5)
342	-- fromList [(-5) % 2,17 % 2]
343	--
344	-- [Performance:] In practice, this outperforms 'Set.filter'.
345	--
346	differenceSetAndInterval :: Ord k => Set k -> Interval k -> Set k
347	differenceSetAndInterval s i = case i of	1✔
348	Whole -> Set.empty	1✔
349	Empty -> s	1✔
NEW 350	Point k -> Set.delete k s	×
351	LessThan k -> intersectionSetAndInterval s (GreaterOrEqual k)	1✔
352	LessOrEqual k -> intersectionSetAndInterval s (GreaterThan k)	1✔
353	GreaterThan k -> intersectionSetAndInterval s (LessOrEqual k)	1✔
354	GreaterOrEqual k -> intersectionSetAndInterval s (LessThan k)	1✔
355	BothClosed lk uk -> let (lt,_,gt) = Set.splitMember uk s in	1✔
356	Set.takeWhileAntitone (< lk) lt `Set.union` gt	1✔
357	LeftOpen lk uk -> let (lt,_,gt) = Set.splitMember uk s in	1✔
358	Set.takeWhileAntitone (<= lk) lt `Set.union` gt	1✔
359	RightOpen lk uk -> let (lt,_,gt) = Set.splitMember lk s in	1✔
360	lt `Set.union` Set.dropWhileAntitone (< uk) gt	1✔
361	BothOpen lk uk ->
362	Set.takeWhileAntitone (<= lk) s `Set.union` Set.dropWhileAntitone (< uk) s	1✔
363	{-# INLINE differenceSetAndInterval #-}

msakai / data-interval / 101

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous