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