src/Gargantext/Prelude.hs

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