src/Data/Gargantext/Prelude.hs

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