]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Prelude.hs
need fix
[gargantext.git] / src / Gargantext / Prelude.hs
1 {-|
2 Module : Gargantext.Prelude
3 Description :
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
19 module Gargantext.Prelude
20 ( module Gargantext.Prelude
21 , module Protolude
22 , headMay
23 , module Text.Show
24 , module Text.Read
25 , cs
26 , module Data.Maybe
27 )
28 where
29
30 import Data.Maybe (isJust, fromJust, maybe)
31 import Protolude ( Bool(True, False), Int, Double, Integer
32 , Fractional, Num, Maybe(Just,Nothing)
33 , Enum, Bounded, Float
34 , Floating, Char, IO
35 , pure, (<*>), (<$>), panic
36 , putStrLn
37 , head, flip
38 , Ord, Integral, Foldable, RealFrac, Monad, filter
39 , reverse, map, mapM, zip, drop, take, zipWith
40 , sum, fromIntegral, length, fmap, foldl, foldl'
41 , takeWhile, sqrt, undefined, identity
42 , abs, min, max, maximum, minimum, return, snd, truncate
43 , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
44 , Eq, (==), (>=), (<=), (<>), (/=)
45 , (&&), (||), not, any
46 , fst, snd, toS
47 , elem, die, mod, div, const, either
48 , curry, uncurry, repeat
49 , otherwise, when
50 , undefined
51 , IO()
52 , compare
53 )
54
55 -- TODO import functions optimized in Utils.Count
56 -- import Protolude hiding (head, last, all, any, sum, product, length)
57 -- import Gargantext.Utils.Count
58 import qualified Data.List as L hiding (head, sum)
59 import qualified Control.Monad as M
60
61 import Data.Map (Map)
62 import qualified Data.Map as M
63
64 import Data.Map.Strict (insertWith)
65 import qualified Data.Vector as V
66 import Safe (headMay)
67 import Text.Show (Show(), show)
68 import Text.Read (Read())
69 import Data.String.Conversions (cs)
70
71 --pf :: (a -> Bool) -> [a] -> [a]
72 --pf = filter
73
74 pr :: [a] -> [a]
75 pr = reverse
76
77 --pm :: (a -> b) -> [a] -> [b]
78 --pm = map
79
80 map2 :: (t -> b) -> [[t]] -> [[b]]
81 map2 fun = map (map fun)
82
83 -- Exponential Average
84 eavg :: [Double] -> Double
85 eavg (x:xs) = a*x + (1-a)*(eavg xs)
86 where a = 0.70
87 eavg [] = 0
88
89 -- Simple Average
90 mean :: Fractional a => [a] -> a
91 mean xs = if L.null xs then 0.0
92 else sum xs / fromIntegral (length xs)
93
94 sumMaybe :: Num a => [Maybe a] -> Maybe a
95 sumMaybe = fmap sum . M.sequence
96
97 variance :: Floating a => [a] -> a
98 variance xs = mean $ map (\x -> (x - m) ** 2) xs where
99 m = mean xs
100
101 deviation :: [Double] -> Double
102 deviation = sqrt . variance
103
104 movingAverage :: Fractional b => Int -> [b] -> [b]
105 movingAverage steps xs = map mean $ chunkAlong steps 1 xs
106
107 ma :: [Double] -> [Double]
108 ma = movingAverage 3
109
110 -- | splitEvery n == chunkAlong n n
111 splitEvery :: Int -> [a] -> [[a]]
112 splitEvery _ [] = L.cycle [[]]
113 splitEvery n xs =
114 let (h,t) = L.splitAt n xs
115 in h : splitEvery n t
116
117 -- | Function to split a range into chunks
118 chunkAlong :: Int -> Int -> [a] -> [[a]]
119 chunkAlong a b l = only (while dropAlong)
120 where
121 only = map (take a)
122 while = takeWhile (\x -> length x >= a)
123 dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
124
125 -- | Optimized version (Vector)
126 chunkAlong' :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
127 chunkAlong' a b l = only (while dropAlong)
128 where
129 only = V.map (V.take a)
130 while = V.takeWhile (\x -> V.length x >= a)
131 dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
132
133 -- | TODO Inverse of chunk ? unchunkAlong ?
134 unchunkAlong :: Int -> Int -> [[a]] -> [a]
135 unchunkAlong = undefined
136
137
138 -- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
139 splitAlong :: [Int] -> [Char] -> [[Char]]
140 splitAlong _ [] = [] -- No list? done
141 splitAlong [] xs = [xs] -- No place to split at? Return the remainder
142 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
143
144 takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
145 takeWhileM _ [] = return []
146 takeWhileM p (a:as) = do
147 v <- a
148 if p v
149 then do
150 vs <- takeWhileM p as
151 return (v:vs)
152 else return []
153
154 -- SUMS
155 -- To select the right algorithme according to the type:
156 -- https://github.com/mikeizbicki/ifcxt
157
158 sumSimple :: Num a => [a] -> a
159 sumSimple = L.foldl' (+) 0
160
161 -- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
162 sumKahan :: Num a => [a] -> a
163 sumKahan = snd . L.foldl' go (0,0)
164 where
165 go (c,t) i = ((t'-t)-y,t')
166 where
167 y = i-c
168 t' = t+y
169
170 -- | compute part of the dict
171 count2map :: (Ord k, Foldable t) => t k -> Map k Double
172 count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)
173
174 -- | insert in a dict
175 count2map' :: (Ord k, Foldable t) => t k -> Map k Double
176 count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
177
178
179 trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
180 trunc n = truncate . (* 10^n)
181
182 trunc' :: Int -> Double -> Double
183 trunc' n x = fromIntegral $ truncate $ (x * 10^n)
184
185
186 bool2int :: Num a => Bool -> a
187 bool2int b = case b of
188 True -> 1
189 False -> 0
190
191 bool2double :: Bool -> Double
192 bool2double bool = case bool of
193 True -> 1.0
194 False -> 0.0
195
196
197
198 -- Normalizing && scaling data
199 scale :: [Double] -> [Double]
200 scale = scaleMinMax
201
202 scaleMinMax :: [Double] -> [Double]
203 scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
204 where
205 ma = maximum xs'
206 mi = minimum xs'
207 xs' = map abs xs
208
209 scaleNormalize :: [Double] -> [Double]
210 scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
211 where
212 v = variance xs'
213 m = mean xs'
214 xs' = map abs xs
215
216
217
218 normalize :: [Double] -> [Double]
219 normalize as = normalizeWith identity as
220
221 normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
222 normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
223 where
224 bs' = map extract bs
225
226 -- Zip functions to add
227 zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
228 zipFst f xs = zip (f xs) xs
229
230 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
231 zipSnd f xs = zip xs (f xs)
232
233 -- Just
234 unMaybe :: [Maybe a] -> [a]
235 unMaybe = map fromJust . L.filter isJust
236
237 -- maximumWith
238 maximumWith f = L.maximumBy (\x y -> compare (f x) (f y))
239