]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Prelude.hs
[External API] list of available APIs through API.
[gargantext.git] / src / Gargantext / Prelude.hs
1 {-|
2 Module : Gargantext.Prelude
3 Description : Specific Prelude of the project
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Here is a longer description of this module, containing some
11 commentary with @some markup@.
12 -}
13
14 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
15 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
16
17 {-# LANGUAGE NoImplicitPrelude #-}
18 {-# LANGUAGE OverloadedStrings #-}
19 {-# LANGUAGE RankNTypes #-}
20
21 module Gargantext.Prelude
22 ( module Gargantext.Prelude
23 , module Protolude
24 , headMay, lastMay
25 , module GHC.Err.Located
26 , module Text.Show
27 , module Text.Read
28 , cs
29 , module Data.Maybe
30 , round
31 , sortWith
32 , module Prelude
33 )
34 where
35
36 import GHC.Exts (sortWith)
37 import GHC.Err.Located (undefined)
38 import GHC.Real (round)
39 import Control.Monad.IO.Class (MonadIO)
40 import Data.Maybe (isJust, fromJust, maybe)
41 import Data.Text (Text)
42 import Protolude ( Bool(True, False), Int, Int64, Double, Integer
43 , Fractional, Num, Maybe(Just,Nothing)
44 , Enum, Bounded, Float
45 , Floating, Char, IO
46 , pure, (>>=), (=<<), (<*>), (<$>)
47 , putStrLn
48 , head, flip
49 , Ord, Integral, Foldable, RealFrac, Monad, filter
50 , reverse, map, mapM, zip, drop, take, zipWith
51 , sum, fromIntegral, length, fmap, foldl, foldl'
52 , takeWhile, sqrt, identity
53 , abs, min, max, maximum, minimum, return, snd, truncate
54 , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
55 , Eq, (==), (>=), (<=), (<>), (/=)
56 , (&&), (||), not, any, all
57 , fst, snd, toS
58 , elem, die, mod, div, const, either
59 , curry, uncurry, repeat
60 , otherwise, when
61 , IO()
62 , compare
63 , on
64 , panic
65 )
66
67 import Prelude (Enum, Bounded, minBound, maxBound)
68 -- TODO import functions optimized in Utils.Count
69 -- import Protolude hiding (head, last, all, any, sum, product, length)
70 -- import Gargantext.Utils.Count
71 import qualified Data.List as L hiding (head, sum)
72 import qualified Control.Monad as M
73
74 import Data.Map (Map)
75 import qualified Data.Map as M
76
77 import Data.Map.Strict (insertWith)
78 import qualified Data.Vector as V
79 import Safe (headMay, lastMay, initMay, tailMay)
80 import Text.Show (Show(), show)
81 import Text.Read (Read())
82 import Data.String.Conversions (cs)
83
84
85 printDebug :: (Show a, MonadIO m) => [Char] -> a -> m ()
86 printDebug msg x = putStrLn $ msg <> " " <> show x
87 -- printDebug _ _ = pure ()
88
89
90 map2 :: (t -> b) -> [[t]] -> [[b]]
91 map2 fun = map (map fun)
92
93
94 -- Some Statistics sugar functions
95 -- Exponential Average
96 eavg :: [Double] -> Double
97 eavg (x:xs) = a*x + (1-a)*(eavg xs)
98 where a = 0.70
99 eavg [] = 0
100
101 -- Simple Average
102 mean :: Fractional a => [a] -> a
103 mean xs = sum xs / fromIntegral (length xs)
104
105
106 sumMaybe :: Num a => [Maybe a] -> Maybe a
107 sumMaybe = fmap sum . M.sequence
108
109 variance :: Floating a => [a] -> a
110 variance xs = sum ys / (fromIntegral (length xs) - 1)
111 where
112 m = mean xs
113 ys = map (\x -> (x - m) ** 2) xs
114
115
116 deviation :: Floating a => [a] -> a
117 deviation = sqrt . variance
118
119 movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
120 movingAverage steps xs = map mean $ chunkAlong steps 1 xs
121
122 ma :: [Double] -> [Double]
123 ma = movingAverage 3
124
125 -- | splitEvery n == chunkAlong n n
126 splitEvery :: Int -> [a] -> [[a]]
127 splitEvery _ [] = []
128 splitEvery n xs =
129 let (h,t) = L.splitAt n xs
130 in h : splitEvery n t
131
132 type Grain = Int
133 type Step = Int
134
135 -- | Function to split a range into chunks
136 -- if step == grain then linearity (splitEvery)
137 -- elif step < grain then overlapping
138 -- else dotted with holes
139 -- TODO FIX BUG if Steps*Grain /= length l
140 -- chunkAlong 10 10 [1..15] == [1..10]
141 -- BUG: what about the rest of (divMod 15 10)?
142 -- TODO: chunkAlongNoRest or chunkAlongWithRest
143 -- default behavior: NoRest
144
145 chunkAlong :: Eq a => Grain -> Step -> [a] -> [[a]]
146 chunkAlong a b l = case a >= length l of
147 True -> [l]
148 False -> chunkAlong' a b l
149
150 chunkAlong' :: Eq a => Grain -> Step -> [a] -> [[a]]
151 chunkAlong' a b l = case a > 0 && b > 0 of
152 True -> chunkAlong'' a b l
153 False -> panic "ChunkAlong: Parameters should be > 0 and Grain > Step"
154
155 chunkAlong'' :: Eq a => Int -> Int -> [a] -> [[a]]
156 chunkAlong'' a b l = filter (/= []) $ only (while dropAlong)
157 where
158 only = map (take a)
159 while = takeWhile (\x -> length x >= a)
160 dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
161
162 -- | Optimized version (Vector)
163 chunkAlongV :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
164 chunkAlongV a b l = only (while dropAlong)
165 where
166 only = V.map (V.take a)
167 while = V.takeWhile (\x -> V.length x >= a)
168 dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
169
170 -- | TODO Inverse of chunk ? unchunkAlong ?
171 -- unchunkAlong :: Int -> Int -> [[a]] -> [a]
172 -- unchunkAlong = undefined
173
174
175 -- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
176 splitAlong :: [Int] -> [Char] -> [[Char]]
177 splitAlong _ [] = [] -- No list? done
178 splitAlong [] xs = [xs] -- No place to split at? Return the remainder
179 splitAlong (x:xs) ys = take x ys : splitAlong xs (drop x ys) -- take until our split spot, recurse with next split spot and list remainder
180
181 takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
182 takeWhileM _ [] = return []
183 takeWhileM p (a:as) = do
184 v <- a
185 if p v
186 then do
187 vs <- takeWhileM p as
188 return (v:vs)
189 else return []
190
191 -- SUMS
192 -- To select the right algorithme according to the type:
193 -- https://github.com/mikeizbicki/ifcxt
194
195 sumSimple :: Num a => [a] -> a
196 sumSimple = L.foldl' (+) 0
197
198 -- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
199 sumKahan :: Num a => [a] -> a
200 sumKahan = snd . L.foldl' go (0,0)
201 where
202 go (c,t) i = ((t'-t)-y,t')
203 where
204 y = i-c
205 t' = t+y
206
207 -- | compute part of the dict
208 count2map :: (Ord k, Foldable t) => t k -> Map k Double
209 count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)
210
211 -- | insert in a dict
212 count2map' :: (Ord k, Foldable t) => t k -> Map k Double
213 count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
214
215
216 trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
217 trunc n = truncate . (* 10^n)
218
219 trunc' :: Int -> Double -> Double
220 trunc' n x = fromIntegral $ truncate $ (x * 10^n)
221
222
223 ------------------------------------------------------------------------
224 bool2num :: Num a => Bool -> a
225 bool2num True = 1
226 bool2num False = 0
227
228 bool2double :: Bool -> Double
229 bool2double = bool2num
230
231 bool2int :: Bool -> Int
232 bool2int = bool2num
233 ------------------------------------------------------------------------
234
235 -- Normalizing && scaling data
236 scale :: [Double] -> [Double]
237 scale = scaleMinMax
238
239 scaleMinMax :: [Double] -> [Double]
240 scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
241 where
242 ma = maximum xs'
243 mi = minimum xs'
244 xs' = map abs xs
245
246 scaleNormalize :: [Double] -> [Double]
247 scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
248 where
249 v = variance xs'
250 m = mean xs'
251 xs' = map abs xs
252
253 normalize :: [Double] -> [Double]
254 normalize as = normalizeWith identity as
255
256 normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
257 normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
258 where
259 bs' = map extract bs
260
261 -- Zip functions to add
262 zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
263 zipFst f xs = zip (f xs) xs
264
265 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
266 zipSnd f xs = zip xs (f xs)
267
268 -- | maximumWith
269 maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
270 maximumWith f = L.maximumBy (compare `on` f)
271
272
273 -- | To get all combinations of a list with no repetition and apply a function to the resulting list of pairs
274 listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)]
275 listToCombi f l = [ (f x, f y) | (x:rest) <- L.tails l, y <- rest ]
276
277 ------------------------------------------------------------------------
278 -- Empty List Sugar Error Handling
279 -- TODO add Garg Monad Errors
280
281 listSafe1 :: Text -> ([a] -> Maybe a)
282 -> Text -> [a] -> a
283 listSafe1 s f e xs = maybe (panic $ h <> e) identity (f xs)
284 where
285 h = "[ERR][Gargantext] Empty list for " <> s <> " in "
286
287 head' :: Text -> [a] -> a
288 head' = listSafe1 "head" headMay
289
290 last' :: Text -> [a] -> a
291 last' = listSafe1 "last" lastMay
292
293 ------------------------------------------------------------------------
294
295 listSafeN :: Text -> ([a] -> Maybe [a])
296 -> Text -> [a] -> [a]
297 listSafeN s f e xs = maybe (panic $ h <> e) identity (f xs)
298 where
299 h = "[ERR][Gargantext] Empty list for " <> s <> " in "
300
301 tail' :: Text -> [a] -> [a]
302 tail' = listSafeN "tail" tailMay
303
304 init' :: Text -> [a] -> [a]
305 init' = listSafeN "init" initMay
306