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