src/Gargantext/Prelude.hs

   1 {-|
   2 Module      : Gargantext.Prelude
   3 Description :
   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
  23   , module Text.Show
  24   , module Text.Read
  25   , cs
  26   , module Data.Maybe
  27   )
  28   where
  29
  30 import Data.Maybe (isJust, fromJust, maybe)
  31 import Protolude ( Bool(True, False), Int, Double, Integer
  32                  , Fractional, Num, Maybe(Just,Nothing)
  33                  , Floating, Char, IO
  34                  , pure, (<$>), panic
  35                  , head, flip
  36                  , Ord, Integral, Foldable, RealFrac, Monad, filter
  37                  , reverse, map, zip, drop, take, zipWith
  38                  , sum, fromIntegral, length, fmap, foldl, foldl'
  39                  , takeWhile, sqrt, undefined, identity
  40                  , abs, min, max, maximum, minimum, return, snd, truncate
  41                  , (+), (*), (/), (-), (.), ($), (**), (^), (<), (>), log
  42                  , Eq, (==), (>=), (<=), (<>), (/=)
  43                  , (&&), (||), not
  44                  , fst, snd, toS
  45                  , elem, die, mod, div
  46                  , curry, uncurry
  47                  )
  48
  49 -- TODO import functions optimized in Utils.Count
  50 -- import Protolude hiding (head, last, all, any, sum, product, length)
  51 -- import Gargantext.Utils.Count
  52 import qualified Data.List     as L hiding (head, sum)
  53 import qualified Control.Monad as M
  54
  55 import Data.Map (Map)
  56 import qualified Data.Map as M
  57
  58 import Data.Map.Strict (insertWith)
  59 import qualified Data.Vector as V
  60 import Safe (headMay)
  61 import Text.Show (Show(), show)
  62 import Text.Read (Read())
  63 import Data.String.Conversions (cs)
  64
  65 --pf :: (a -> Bool) -> [a] -> [a]
  66 --pf = filter
  67
  68 pr :: [a] -> [a]
  69 pr = reverse
  70
  71 --pm :: (a -> b) -> [a] -> [b]
  72 --pm = map
  73
  74 map2 :: (t -> b) -> [[t]] -> [[b]]
  75 map2 fun = map (map fun)
  76
  77 pz :: [a] -> [b] -> [(a, b)]
  78 pz  = zip
  79
  80 pd :: Int -> [a] -> [a]
  81 pd  = drop
  82
  83 ptk :: Int -> [a] -> [a]
  84 ptk = take
  85
  86 pzw :: (a -> b -> c) -> [a] -> [b] -> [c]
  87 pzw = zipWith
  88
  89 -- Exponential Average
  90 eavg :: [Double] -> Double
  91 eavg (x:xs) = a*x + (1-a)*(eavg xs)
  92   where a = 0.70
  93 eavg [] = 0
  94
  95 -- Simple Average
  96 mean :: Fractional a => [a] -> a
  97 mean xs = if L.null xs then 0.0
  98                        else sum xs / fromIntegral (length xs)
  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
 117 -- | Function to split a range into chunks
 118 chunkAlong :: Int -> Int -> [a] -> [[a]]
 119 chunkAlong a b l = only (while  dropAlong)
 120     where
 121         only      = map (take a)
 122         while     = takeWhile  (\x -> length x >= a)
 123         dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
 124
 125 -- | Optimized version (Vector)
 126 chunkAlong' :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
 127 chunkAlong' a b l = only (while  dropAlong)
 128     where
 129         only      = V.map (V.take a)
 130         while     = V.takeWhile  (\x -> V.length x >= a)
 131         dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
 132
 133 -- | TODO Inverse of chunk ? unchunkAlong ?
 134 unchunkAlong :: Int -> Int -> [[a]] -> [a]
 135 unchunkAlong = undefined
 136
 137
 138 -- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
 139 splitAlong :: [Int] -> [Char] -> [[Char]]
 140 splitAlong _ [] = [] -- No list? done
 141 splitAlong [] xs = [xs] -- No place to split at? Return the remainder
 142 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
 143
 144 takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
 145 takeWhileM _ [] = return []
 146 takeWhileM p (a:as) = do
 147     v <- a
 148     if p v
 149         then do
 150             vs <- takeWhileM p as
 151             return (v:vs)
 152         else return []
 153
 154 -- SUMS
 155 -- To select the right algorithme according to the type:
 156 -- https://github.com/mikeizbicki/ifcxt
 157
 158 sumSimple :: Num a => [a] -> a
 159 sumSimple = L.foldl' (+) 0
 160
 161 -- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
 162 sumKahan :: Num a => [a] -> a
 163 sumKahan = snd . L.foldl' go (0,0)
 164     where
 165         go (c,t) i = ((t'-t)-y,t')
 166             where
 167                 y  = i-c
 168                 t' = t+y
 169
 170 -- | compute part of the dict
 171 count2map :: (Ord k, Foldable t) => t k -> Map k Double
 172 count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)
 173
 174 -- | insert in a dict
 175 count2map' :: (Ord k, Foldable t) => t k -> Map k Double
 176 count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
 177
 178
 179 trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
 180 trunc n = truncate . (* 10^n)
 181
 182 trunc' :: Int -> Double -> Double
 183 trunc' n x = fromIntegral $ truncate $ (x * 10^n)
 184
 185
 186 bool2int :: Num a => Bool -> a
 187 bool2int b = case b of
 188                   True  -> 1
 189                   False -> 0
 190
 191 bool2double :: Bool -> Double
 192 bool2double bool = case bool of
 193                   True  -> 1.0
 194                   False -> 0.0
 195
 196
 197
 198 -- Normalizing && scaling data
 199 scale :: [Double] -> [Double]
 200 scale = scaleMinMax
 201
 202 scaleMinMax :: [Double] -> [Double]
 203 scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
 204     where
 205         ma  = maximum xs'
 206         mi  = minimum xs'
 207         xs' = map abs xs
 208
 209 scaleNormalize :: [Double] -> [Double]
 210 scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
 211     where
 212         v = variance xs'
 213         m = mean     xs'
 214         xs' = map abs xs
 215
 216
 217
 218 normalize :: [Double] -> [Double]
 219 normalize as = normalizeWith identity as
 220
 221 normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
 222 normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
 223     where
 224         bs' = map extract bs
 225
 226 -- Zip functions to add
 227 zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
 228 zipFst  f xs = zip (f xs) xs
 229
 230 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
 231 zipSnd f xs = zip xs (f xs)
 232
 233
 234 -- Just
 235 unMaybe :: [Maybe a] -> [a]
 236 unMaybe = map fromJust . L.filter isJust
 237
 238 -- | Syntactic convention for the reader/writer coordination.
 239 -- @Motivation@: explicit functional flux ease coordination between
 240 -- readers and writers who are not always the same individuals. Each
 241 -- natural languages has its own syntaxical conventions from left to
 242 -- right or the contrary. In computer programming languages it depends
 243 -- on context of the algorithm itself and we need some clarity since
 244 -- both are possible, here is a proposition to get more explicitiness.
 245
 246 -- | (~>) is called : "rightLeft" as "from right to left". The most right
 247 -- function sends its output to the most left function which takes it as
 248 -- input.
 249 (<|) :: (a -> b) -> a -> b
 250 (<|) = ($)
 251
 252 -- | (<~) is called : "leftRight" as "from left to right". The most left
 253 -- function sends its output to the most right function which takes it as
 254 -- input.
 255 (|>) :: a -> (a -> c) -> c
 256 (|>) = flip ($)
 257
 258