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
10 Here is a longer description of this module, containing some
11 commentary with @some markup@.
14 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
15 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
17 {-# LANGUAGE NoImplicitPrelude #-}
18 {-# LANGUAGE OverloadedStrings #-}
19 {-# LANGUAGE RankNTypes #-}
21 module Gargantext.Prelude
22 ( module Gargantext.Prelude
25 , module GHC.Err.Located
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
46 , pure, (>>=), (=<<), (<*>), (<$>)
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
58 , elem, die, mod, div, const, either
59 , curry, uncurry, repeat
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
75 import qualified Data.Map as M
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)
85 printDebug :: (Show a, MonadIO m) => [Char] -> a -> m ()
86 printDebug msg x = putStrLn $ msg <> " " <> show x
87 -- printDebug _ _ = pure ()
90 map2 :: (t -> b) -> [[t]] -> [[b]]
91 map2 fun = map (map fun)
94 -- Some Statistics sugar functions
95 -- Exponential Average
96 eavg :: [Double] -> Double
97 eavg (x:xs) = a*x + (1-a)*(eavg xs)
102 mean :: Fractional a => [a] -> a
103 mean xs = sum xs / fromIntegral (length xs)
106 sumMaybe :: Num a => [Maybe a] -> Maybe a
107 sumMaybe = fmap sum . M.sequence
109 variance :: Floating a => [a] -> a
110 variance xs = sum ys / (fromIntegral (length xs) - 1)
113 ys = map (\x -> (x - m) ** 2) xs
116 deviation :: Floating a => [a] -> a
117 deviation = sqrt . variance
119 movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
120 movingAverage steps xs = map mean $ chunkAlong steps 1 xs
122 ma :: [Double] -> [Double]
125 -- | splitEvery n == chunkAlong n n
126 splitEvery :: Int -> [a] -> [[a]]
129 let (h,t) = L.splitAt n xs
130 in h : splitEvery n t
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
145 chunkAlong :: Eq a => Grain -> Step -> [a] -> [[a]]
146 chunkAlong a b l = case a >= length l of
148 False -> chunkAlong' a b l
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"
155 chunkAlong'' :: Eq a => Int -> Int -> [a] -> [[a]]
156 chunkAlong'' a b l = filter (/= []) $ only (while dropAlong)
159 while = takeWhile (\x -> length x >= a)
160 dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
162 -- | Optimized version (Vector)
163 chunkAlongV :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
164 chunkAlongV a b l = only (while dropAlong)
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..])
170 -- | TODO Inverse of chunk ? unchunkAlong ?
171 -- unchunkAlong :: Int -> Int -> [[a]] -> [a]
172 -- unchunkAlong = undefined
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
181 takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
182 takeWhileM _ [] = return []
183 takeWhileM p (a:as) = do
187 vs <- takeWhileM p as
192 -- To select the right algorithme according to the type:
193 -- https://github.com/mikeizbicki/ifcxt
195 sumSimple :: Num a => [a] -> a
196 sumSimple = L.foldl' (+) 0
198 -- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
199 sumKahan :: Num a => [a] -> a
200 sumKahan = snd . L.foldl' go (0,0)
202 go (c,t) i = ((t'-t)-y,t')
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)
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
216 trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
217 trunc n = truncate . (* 10^n)
219 trunc' :: Int -> Double -> Double
220 trunc' n x = fromIntegral $ truncate $ (x * 10^n)
223 ------------------------------------------------------------------------
224 bool2num :: Num a => Bool -> a
228 bool2double :: Bool -> Double
229 bool2double = bool2num
231 bool2int :: Bool -> Int
233 ------------------------------------------------------------------------
235 -- Normalizing && scaling data
236 scale :: [Double] -> [Double]
239 scaleMinMax :: [Double] -> [Double]
240 scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
246 scaleNormalize :: [Double] -> [Double]
247 scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
253 normalize :: [Double] -> [Double]
254 normalize as = normalizeWith identity as
256 normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
257 normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
261 -- Zip functions to add
262 zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
263 zipFst f xs = zip (f xs) xs
265 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
266 zipSnd f xs = zip xs (f xs)
269 maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
270 maximumWith f = L.maximumBy (compare `on` f)
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 ]
277 ------------------------------------------------------------------------
278 -- Empty List Sugar Error Handling
279 -- TODO add Garg Monad Errors
281 listSafe1 :: Text -> ([a] -> Maybe a)
283 listSafe1 s f e xs = maybe (panic $ h <> e) identity (f xs)
285 h = "[ERR][Gargantext] Empty list for " <> s <> " in "
287 head' :: Text -> [a] -> a
288 head' = listSafe1 "head" headMay
290 last' :: Text -> [a] -> a
291 last' = listSafe1 "last" lastMay
293 ------------------------------------------------------------------------
295 listSafeN :: Text -> ([a] -> Maybe [a])
296 -> Text -> [a] -> [a]
297 listSafeN s f e xs = maybe (panic $ h <> e) identity (f xs)
299 h = "[ERR][Gargantext] Empty list for " <> s <> " in "
301 tail' :: Text -> [a] -> [a]
302 tail' = listSafeN "tail" tailMay
304 init' :: Text -> [a] -> [a]
305 init' = listSafeN "init" initMay