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