]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Filter/Reduce.hs
Polissage : Lib.Parsec : espaces.
[comptalang.git] / lib / Hcompta / Filter / Reduce.hs
1 -- | The whole point of this module is
2 -- to reach sub-linear time complexity
3 -- when filtering with 'Filter_Bool'
4 -- over sorted inputs, doing this by:
5 --
6 -- 1. Deriving from a generic 'Filter_Bool':
7 -- a specific 'Filter_Bool' only testing
8 -- on the input's sorting key, such that
9 -- it forms a necessary (obviously not sufficient) filter
10 -- to pass for an input's sorting key to let it filter-in (eg. 'bool_date').
11 -- 2. Deriving from this specific 'Filter_Bool':
12 -- a 'Sieve' uniquely uniting 'Interval's
13 -- spanning over sorting keys of inputs
14 -- which can filter-in (eg. 'sieve_date').
15 -- 3. Slicing the input according to this 'Sieve':
16 -- to filter-out inputs which cannot possibly filter-in
17 -- (eg. 'map_date').
18 --
19 -- In the end, this module potentially gives less time complexity, but:
20 --
21 -- * this is only sensible on large inputs;
22 -- * this significantly increases the code complexity
23 -- of the filtering algorithm, hence its reliability.
24 module Hcompta.Filter.Reduce where
25
26 import Control.Arrow ((***))
27 import Control.Monad (join)
28 import Data.Maybe (fromJust)
29 import qualified Data.List
30 import Data.Map.Strict (Map)
31
32 import Hcompta.Date (Date)
33 import qualified Hcompta.Date as Date
34 import qualified Hcompta.Date.Interval as Date.Interval
35 import Hcompta.Filter
36 import qualified Hcompta.Lib.Interval as Interval
37 import qualified Hcompta.Lib.Interval.Sieve as Interval.Sieve
38 import qualified Hcompta.Lib.Map.Strict as Map
39
40 -- * Class 'Dated'
41
42 type Reduce_Date = Filter_Bool Filter_Date
43
44 class Dated t where
45 dated :: t -> Maybe (Filter_Bool Filter_Date)
46
47 instance Dated Filter_Date where
48 dated = Just . Bool
49 instance Transaction t
50 => Dated (Filter_Transaction t) where
51 dated t =
52 case t of
53 Filter_Transaction_Date d -> Just d
54 _ -> Nothing
55
56 -- | Return a 'Reduce_Date'
57 -- which must filter
58 -- for the given 'Filter_Bool' to filter.
59 bool_date :: Dated t => Filter_Bool t -> Simplified Reduce_Date
60 bool_date tst =
61 simplify (maybe Any id $ go tst)
62 where
63 go :: Dated t
64 => Filter_Bool t
65 -> Maybe Reduce_Date
66 go tb =
67 case tb of
68 Any -> Just $ Any
69 (Bool td) -> dated td
70 (Not t) -> Not <$> go t
71 (And t0 t1) ->
72 case (go t0, go t1) of
73 (Nothing, Nothing) -> Just $ Any
74 (Nothing, Just td) -> Just $ td
75 (Just td, Nothing) -> Just $ td
76 (Just td0, Just td1) -> Just $ And td0 td1
77 (Or t0 t1) ->
78 case (go t0, go t1) of
79 (Just td0, Just td1) -> Just $ Or td0 td1
80 _ -> Just $ Any
81
82 -- | Return given 'Interval.Sieve.Sieve' 'Date'
83 -- with given 'Reduce_Date' applied on it.
84 --
85 -- WARNING: no reducing is done below the day level.
86 sieve_date
87 :: Reduce_Date
88 -> Interval.Sieve.Sieve Date
89 -> Interval.Sieve.Sieve Date
90 sieve_date tb si =
91 case Interval.Sieve.interval si of
92 Nothing -> si
93 Just bounds -> go bounds tb si
94 where
95 go bounds t s =
96 case t of
97 Any -> s
98 (Not t0) ->
99 Interval.Sieve.complement_with bounds $
100 go bounds t0 s
101 (And t0 t1) ->
102 Interval.Sieve.intersection
103 (go bounds t0 s)
104 (go bounds t1 s)
105 (Or t0 t1) ->
106 Interval.Sieve.union
107 (go bounds t0 s)
108 (go bounds t1 s)
109 (Bool td) ->
110 case td of
111 Filter_Date_UTC to ->
112 Interval.Sieve.intersection s $
113 Interval.Sieve.singleton $
114 case to of
115 Filter_Ord_Lt o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.Out o)
116 Filter_Ord_Le o -> fromJust $ Interval.interval (Interval.low bounds) (Interval.Limit Interval.In o)
117 Filter_Ord_Eq o -> Interval.point o
118 Filter_Ord_Ge o -> fromJust $ Interval.interval (Interval.Limit Interval.In o) (Interval.high bounds)
119 Filter_Ord_Gt o -> fromJust $ Interval.interval (Interval.Limit Interval.Out o) (Interval.high bounds)
120 Filter_Ord_Any -> bounds
121 Filter_Date_Year (Filter_Interval_In i) ->
122 Interval.Sieve.intersection s $
123 Interval.Sieve.singleton $
124 fromJust $ uncurry Interval.interval $
125 join (***)
126 (\u -> case u of
127 Interval.Unlimited_low -> Interval.low bounds
128 Interval.Limited l -> l
129 Interval.Unlimited_high -> Interval.high bounds) $
130 (fmap Interval.low *** fmap Interval.high) $
131 join (***) (fmap Date.Interval.year . Interval.limit) $
132 Interval.limits i
133 Filter_Date_Month (Filter_Interval_In i) ->
134 case Interval.Sieve.interval s of
135 Nothing -> s
136 Just cover ->
137 Interval.Sieve.intersection s $
138 Interval.Sieve.from_Foldable $
139 Data.List.filter
140 (\slice ->
141 Interval.within
142 (Interval.Limited $
143 Date.month $
144 Interval.limit $
145 Interval.low slice)
146 i) $
147 Date.Interval.slice
148 Date.Interval.month_slice
149 cover
150 Filter_Date_DoM (Filter_Interval_In i) ->
151 case Interval.Sieve.interval s of
152 Nothing -> s
153 Just cover ->
154 Interval.Sieve.intersection s $
155 Interval.Sieve.from_Foldable $
156 Data.List.filter
157 (\slice ->
158 Interval.within
159 (Interval.Limited $
160 Date.dom $
161 Interval.limit $
162 Interval.low slice)
163 i) $
164 Date.Interval.slice
165 Date.Interval.dom_slice
166 cover
167 Filter_Date_Hour _ti -> s -- NOTE: no reducing at this level
168 Filter_Date_Minute _ti -> s -- NOTE: no reducing at this level
169 Filter_Date_Second _ti -> s -- NOTE: no reducing at this level
170
171 -- | Return given 'Map' with 'Map.slice' applied on it
172 -- to only get sub-'Map's filtering through given 'Reduce_Date',
173 -- also return derived 'Interval.Sieve.Sieve' used for the slicing.
174 map_date :: Simplified Reduce_Date -> Map Date x -> ([Map Date x], Interval.Sieve.Sieve Date)
175 map_date reducer m =
176 let sieve =
177 case Map.interval m of
178 Nothing -> Interval.Sieve.empty
179 Just bounds ->
180 case simplified reducer of
181 Left tb -> sieve_date tb $ Interval.Sieve.singleton bounds
182 Right True -> Interval.Sieve.singleton bounds
183 Right False -> Interval.Sieve.empty in
184 (Map.slice sieve m, sieve)