[REFACT] FlowList integration to Terms with instances
[gargantext.git] / src / Gargantext / Prelude.hs
index cc19ce3968a08b47cbf48e1929cfdc28433c6dd0..7179d43600b6b03a4b07340560dee716c4368281 100644 (file)
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults  #-}
-{-# LANGUAGE     NoImplicitPrelude       #-}
+{-|
+Module      : Gargantext.Prelude
+Description : Specific Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
 
-{-
-TODO: import head impossible from Protolude: why ?
 -}
 
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults  #-}
+
 module Gargantext.Prelude
   ( module Gargantext.Prelude
   , module Protolude
-  , headMay
+  , headMay, lastMay
+  , module GHC.Err.Located
   , module Text.Show
   , module Text.Read
+  , cs
+  , module Data.Maybe
+  , round
+  , sortWith
+  , module Prelude
+  , MonadBase(..)
+  , Typeable
   )
   where
 
-import Protolude ( Bool(True, False), Int, Double, Integer
+import Control.Monad.Base (MonadBase(..))
+import GHC.Exts (sortWith)
+import GHC.Err.Located (undefined)
+import GHC.Real (round)
+import Data.Map (Map, lookup)
+import Data.Maybe (isJust, fromJust, maybe)
+import Data.Text (Text)
+import Data.Typeable (Typeable)
+import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                  , Fractional, Num, Maybe(Just,Nothing)
+                 , Enum, Bounded, Float
                  , Floating, Char, IO
-                 , pure, (<$>), panic
+                 , pure, (>>=), (=<<), (<*>), (<$>), (<&>), (>>)
+                 , head, flip
                  , Ord, Integral, Foldable, RealFrac, Monad, filter
-                 , reverse, map, zip, drop, take, zipWith
-                 , sum, fromIntegral, length, fmap
-                 , takeWhile, sqrt, undefined, identity
-                 , abs, maximum, minimum, return, snd, truncate
-                 , (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>), (==), (<>)
+                 , reverse, map, mapM, zip, drop, take, zipWith
+                 , sum, fromIntegral, length, fmap, foldl, foldl'
+                 , takeWhile, sqrt, identity
+                 , abs, min, max, maximum, minimum, return, snd, truncate
+                 , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
+                 , Eq, (==), (>=), (<=), (<>), (/=)
+                 , (&&), (||), not, any, all
+                 , concatMap
+                 , fst, snd, toS
+                 , elem, die, mod, div, const, either
+                 , curry, uncurry, repeat
+                 , otherwise, when
+                 , IO()
+                 , compare
+                 , on
+                 , panic
+                 , seq
                  )
 
+import Prelude (Enum, Bounded, minBound, maxBound, putStrLn)
 -- TODO import functions optimized in Utils.Count
 -- import Protolude hiding (head, last, all, any, sum, product, length)
 -- import Gargantext.Utils.Count
-
 import qualified Data.List     as L hiding (head, sum)
 import qualified Control.Monad as M
-import qualified Data.Map as Map
+import qualified Data.Map      as M
 import Data.Map.Strict (insertWith)
 import qualified Data.Vector as V
-import Safe (headMay)
+import Safe (headMay, lastMay, initMay, tailMay)
 import Text.Show (Show(), show)
 import Text.Read (Read())
---pf :: (a -> Bool) -> [a] -> [a]
---pf = filter
-
-pr :: [a] -> [a]
-pr = reverse
-
---pm :: (a -> b) -> [a] -> [b]
---pm = map
-
-map2 :: (t -> b) -> [[t]] -> [[b]]
-map2 fun = map (map fun)
-
-pz :: [a] -> [b] -> [(a, b)]
-pz  = zip
+import Data.String.Conversions (cs)
 
-pd :: Int -> [a] -> [a]
-pd  = drop
 
-ptk :: Int -> [a] -> [a]
-ptk = take
+printDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
+printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x
+-- printDebug _ _ = pure ()
 
-pzw :: (a -> b -> c) -> [a] -> [b] -> [c]
-pzw = zipWith
 
--- Exponential Average
-eavg :: [Double] -> Double
-eavg (x:xs) = a*x + (1-a)*(eavg xs)
-  where a = 0.70
-eavg [] = 0
-
--- Simple Average
-mean :: Fractional a => [a] -> a
-mean xs = if L.null xs then 0.0
-                       else sum xs / fromIntegral (length xs)
-
-sumMaybe :: Num a => [Maybe a] -> Maybe a
-sumMaybe = fmap sum . M.sequence
-
-variance :: Floating a => [a] -> a
-variance xs = mean $ map (\x -> (x - m) ** 2) xs where
-    m = mean xs
-
-deviation :: [Double] -> Double
-deviation = sqrt . variance
-
-movingAverage :: Fractional b => Int -> [b] -> [b]
-movingAverage steps xs = map mean $ chunkAlong steps 1 xs
-
-ma :: [Double] -> [Double]
-ma = movingAverage 3
+-- | splitEvery n == chunkAlong n n
+splitEvery :: Int -> [a] -> [[a]]
+splitEvery _ [] = []
+splitEvery n xs =
+  let (h,t) = L.splitAt n xs
+  in  h : splitEvery n t
 
+type Grain = Int
+type Step  = Int
 
 -- | Function to split a range into chunks
-chunkAlong :: Int -> Int -> [a] -> [[a]]
-chunkAlong a b l = only (while  dropAlong)
-    where
-        only      = map (take a)
-        while     = takeWhile  (\x -> length x >= a)
-        dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
+-- if   step == grain then linearity (splitEvery)
+-- elif step < grain then overlapping
+-- else dotted with holes
+-- TODO FIX BUG if Steps*Grain /= length l
+-- chunkAlong 10 10 [1..15] == [1..10]
+-- BUG: what about the rest of (divMod 15 10)?
+-- TODO: chunkAlongNoRest or chunkAlongWithRest
+-- default behavior: NoRest
+
+chunkAlong :: Eq a => Grain -> Step -> [a] -> [[a]]
+chunkAlong a b l = case a >= length l of
+  True  -> [l]
+  False -> chunkAlong' a b l
+
+chunkAlong' :: Eq a => Grain -> Step -> [a] -> [[a]]
+chunkAlong' a b l = case a > 0 && b > 0 of
+  True  -> chunkAlong'' a b l
+  False -> panic "ChunkAlong: Parameters should be > 0 and Grain > Step"
+
+chunkAlong'' :: Eq a => Int -> Int -> [a] -> [[a]]
+chunkAlong'' a b l = filter (/= []) $ only (while dropAlong)
+  where
+    only      = map       (take a)
+    while     = takeWhile (\x -> length x >= a)
+    dropAlong = L.scanl   (\x _y -> drop b x) l ([1..] :: [Integer])
 
 -- | Optimized version (Vector)
-chunkAlong' :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
-chunkAlong' a b l = only (while  dropAlong)
-    where
-        only      = V.map (V.take a)
-        while     = V.takeWhile  (\x -> V.length x >= a)
-        dropAlong = V.scanl (\x _y -> V.drop b x) l (V.fromList [1..])
+chunkAlongV :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
+chunkAlongV a b l = only (while  dropAlong)
+  where
+    only      = V.map       (V.take a)
+    while     = V.takeWhile (\x -> V.length x >= a)
+    dropAlong = V.scanl     (\x _y -> V.drop b x) l (V.fromList [1..])
 
 -- | TODO Inverse of chunk ? unchunkAlong ?
-unchunkAlong :: Int -> Int -> [[a]] -> [a]
-unchunkAlong = undefined
+-- unchunkAlong :: Int -> Int -> [[a]] -> [a]
+-- unchunkAlong = undefined
 
 
 -- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
 splitAlong :: [Int] -> [Char] -> [[Char]]
 splitAlong _ [] = [] -- No list? done
 splitAlong [] xs = [xs] -- No place to split at? Return the remainder
-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
+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
 
 takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
 takeWhileM _ [] = return []
@@ -145,13 +167,12 @@ sumKahan = snd . L.foldl' go (0,0)
                 t' = t+y
 
 -- | compute part of the dict
-count2map :: (Ord k, Foldable t) => t k -> Map.Map k Double
-count2map xs = Map.map (/ (fromIntegral (length xs))) (count2map' xs)
+count2map :: (Ord k, Foldable t) => t k -> Map k Double
+count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)
 
 -- | insert in a dict
-count2map' :: (Ord k, Foldable t) => t k -> Map.Map k Double
-count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) Map.empty xs
-
+count2map' :: (Ord k, Foldable t) => t k -> Map k Double
+count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs
 
 trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
 trunc n = truncate . (* 10^n)
@@ -159,18 +180,17 @@ trunc n = truncate . (* 10^n)
 trunc' :: Int -> Double -> Double
 trunc' n x = fromIntegral $ truncate $ (x * 10^n)
 
-
-bool2int :: Num a => Bool -> a
-bool2int b = case b of
-                  True  -> 1
-                  False -> 0
+------------------------------------------------------------------------
+bool2num :: Num a => Bool -> a
+bool2num True  = 1
+bool2num False = 0
 
 bool2double :: Bool -> Double
-bool2double bool = case bool of
-                  True  -> 1.0
-                  False -> 0.0
-
+bool2double = bool2num
 
+bool2int :: Bool -> Int
+bool2int = bool2num
+------------------------------------------------------------------------
 
 -- Normalizing && scaling data
 scale :: [Double] -> [Double]
@@ -186,11 +206,9 @@ scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
 scaleNormalize :: [Double] -> [Double]
 scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
     where
-        v = variance xs'
-        m = mean     xs'
-        xs' = map abs xs
-
-
+        v   = variance  xs'
+        m   = mean      xs'
+        xs' = map abs   xs
 
 normalize :: [Double] -> [Double]
 normalize as = normalizeWith identity as
@@ -206,3 +224,94 @@ zipFst  f xs = zip (f xs) xs
 
 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
 zipSnd f xs = zip xs (f xs)
+
+-- | maximumWith
+maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
+maximumWith f = L.maximumBy (compare `on` f)
+
+-- | To get all combinations of a list with no
+-- repetition and apply a function to the resulting list of pairs
+listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)]
+listToCombi f l = [ (f x, f y) | (x:rest) <- L.tails l,  y <- rest ]
+
+------------------------------------------------------------------------
+-- Empty List Sugar Error Handling
+-- TODO add Garg Monad Errors
+
+listSafe1 :: Text -> ([a] -> Maybe a)
+          -> Text -> [a] -> a
+listSafe1 s f e xs = maybe (panic $ h <> e) identity (f xs)
+  where
+    h = "[ERR][Gargantext] Empty list for " <> s <> " in "
+
+head' :: Text -> [a] -> a
+head' = listSafe1 "head" headMay
+
+last' :: Text -> [a] -> a
+last' = listSafe1 "last" lastMay
+
+------------------------------------------------------------------------
+
+listSafeN :: Text -> ([a] -> Maybe [a])
+          -> Text -> [a] -> [a]
+listSafeN s f e xs = maybe (panic $ h <> e) identity (f xs)
+  where
+    h = "[ERR][Gargantext] Empty list for " <> s <> " in "
+
+tail' :: Text -> [a] -> [a]
+tail' = listSafeN "tail" tailMay
+
+init' :: Text -> [a] -> [a]
+init' = listSafeN "init" initMay
+
+------------------------------------------------------------------------
+--- Some Statistics sugar functions
+-- Exponential Average
+eavg :: [Double] -> Double
+eavg (x:xs) = a*x + (1-a)*(eavg xs)
+  where a = 0.70
+eavg [] = 0
+
+-- Simple Average
+mean :: Fractional a => [a] -> a
+mean xs = sum xs / fromIntegral (length xs)
+
+sumMaybe :: Num a => [Maybe a] -> Maybe a
+sumMaybe = fmap sum . M.sequence
+
+variance :: Floating a => [a] -> a
+variance xs = sum ys  / (fromIntegral (length xs) - 1)
+  where
+    m = mean xs
+    ys = map (\x -> (x - m) ** 2) xs
+
+deviation :: Floating a => [a] -> a
+deviation = sqrt . variance
+
+movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
+movingAverage steps xs = map mean $ chunkAlong steps 1 xs
+
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+--- Map in Map = Map2
+-- To avoid Map (a,a) b
+type Map2 a b = Map a (Map a b)
+
+lookup2 :: Ord a
+        => a
+        -> a
+        -> Map2 a b
+        -> Maybe b
+lookup2 a b m = do
+  m' <- lookup a m
+  lookup b m'
+
+-----------------------------------------------
+
+foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+foldM' _ z [] = return z
+foldM' f z (x:xs) = do
+  z' <- f z x
+  z' `seq` foldM' f z' xs
+
+