]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Prelude.hs
Merge remote-tracking branch 'origin/stack-update'
[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 :: 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 -- | Function to split a range into chunks
124 chunkAlong :: Int -> Int -> [a] -> [[a]]
125 chunkAlong a b l = only (while dropAlong)
126 where
127 only = map (take a)
128 while = takeWhile (\x -> length x >= a)
129 dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
130
131 -- | Optimized version (Vector)
132 chunkAlong' :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
133 chunkAlong' a b l = only (while dropAlong)
134 where
135 only = V.map (V.take a)
136 while = V.takeWhile (\x -> V.length x >= a)
137 dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
138
139 -- | TODO Inverse of chunk ? unchunkAlong ?
140 -- unchunkAlong :: Int -> Int -> [[a]] -> [a]
141 -- unchunkAlong = undefined
142
143
144 -- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
145 splitAlong :: [Int] -> [Char] -> [[Char]]
146 splitAlong _ [] = [] -- No list? done
147 splitAlong [] xs = [xs] -- No place to split at? Return the remainder
148 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
149
150 takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
151 takeWhileM _ [] = return []
152 takeWhileM p (a:as) = do
153 v <- a
154 if p v
155 then do
156 vs <- takeWhileM p as
157 return (v:vs)
158 else return []
159
160 -- SUMS
161 -- To select the right algorithme according to the type:
162 -- https://github.com/mikeizbicki/ifcxt
163
164 sumSimple :: Num a => [a] -> a
165 sumSimple = L.foldl' (+) 0
166
167 -- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
168 sumKahan :: Num a => [a] -> a
169 sumKahan = snd . L.foldl' go (0,0)
170 where
171 go (c,t) i = ((t'-t)-y,t')
172 where
173 y = i-c
174 t' = t+y
175
176 -- | compute part of the dict
177 count2map :: (Ord k, Foldable t) => t k -> Map k Double
178 count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)
179
180 -- | insert in a dict
181 count2map' :: (Ord k, Foldable t) => t k -> Map k Double
182 count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
183
184
185 trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
186 trunc n = truncate . (* 10^n)
187
188 trunc' :: Int -> Double -> Double
189 trunc' n x = fromIntegral $ truncate $ (x * 10^n)
190
191
192 ------------------------------------------------------------------------
193 bool2num :: Num a => Bool -> a
194 bool2num True = 1
195 bool2num False = 0
196
197 bool2double :: Bool -> Double
198 bool2double = bool2num
199
200 bool2int :: Bool -> Int
201 bool2int = bool2num
202 ------------------------------------------------------------------------
203
204 -- Normalizing && scaling data
205 scale :: [Double] -> [Double]
206 scale = scaleMinMax
207
208 scaleMinMax :: [Double] -> [Double]
209 scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
210 where
211 ma = maximum xs'
212 mi = minimum xs'
213 xs' = map abs xs
214
215 scaleNormalize :: [Double] -> [Double]
216 scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
217 where
218 v = variance xs'
219 m = mean xs'
220 xs' = map abs xs
221
222 normalize :: [Double] -> [Double]
223 normalize as = normalizeWith identity as
224
225 normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
226 normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
227 where
228 bs' = map extract bs
229
230 -- Zip functions to add
231 zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
232 zipFst f xs = zip (f xs) xs
233
234 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
235 zipSnd f xs = zip xs (f xs)
236
237 -- | maximumWith
238 maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
239 maximumWith f = L.maximumBy (compare `on` f)
240