src/Gargantext/Core/Utils/Count.purs

   1 {-|
   2 Module      : Gargantext.Core.Utils.Count
   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 Inspired from Gabriel Gonzales, "beautiful folds" talk.
  14
  15 -}
  16
  17 {-# LANGUAGE ExistentialQuantification #-}
  18 {-# LANGUAGE BangPatterns #-}
  19
  20 module Gargantext.Core.Utils.Count (head, last, all, any, sum, product, length)
  21     where
  22
  23 import Data.Functor
  24 import Control.Applicative
  25 import qualified Data.Foldable
  26 import Data.Monoid
  27 import Control.Lens (Getting, foldMapOf)
  28
  29 import Gargantext.Prelude hiding (head, sum, length)
  30
  31 data Fold i o = forall m . Monoid m => Fold (i -> m) (m -> o)
  32
  33 instance Functor (Fold i) where
  34     fmap k (Fold tally summarize) = Fold tally (k . summarize)
  35
  36 instance Applicative (Fold i) where
  37     pure o = Fold (\_ -> ()) (\_ -> o)
  38
  39     Fold tallyF summarizeF <*> Fold tallyX summarizeX = Fold tally summarize
  40         where
  41             tally i = (tallyF i, tallyX i)
  42             summarize (nF, nX) = summarizeF nF (summarizeX nX)
  43
  44 focus :: (forall m . Monoid m => Getting m b a) -> Fold a o -> Fold b o
  45 focus lens (Fold tally summarize) = Fold (foldMapOf lens tally) summarize
  46
  47
  48 fold :: Fold i o -> [i] -> o
  49 fold (Fold tally summarize) is = summarize (reduce (map tally is))
  50     where
  51         reduce = Data.Foldable.foldl' (<>) mempty
  52
  53 --
  54 head :: Fold a (Maybe a)
  55 head = Fold (First . Just) getFirst
  56
  57 last :: Fold a (Maybe a)
  58 last = Fold (Last . Just) getLast
  59 --
  60 all :: (a -> Bool) -> Fold a Bool
  61 all predicate = Fold (All . predicate) getAll
  62
  63 any :: (a -> Bool) -> Fold a Bool
  64 any predicate = Fold (Any . predicate) getAny
  65 --
  66 sum :: Num n => Fold n n
  67 sum = Fold Sum getSum
  68
  69 product :: Num n => Fold n n
  70 product = Fold Product getProduct
  71
  72 length :: Num n => Fold i n
  73 length = Fold (\_ -> Sum 1) getSum
  74
  75
  76 -- | Average function optimized (/!\ need to test it)
  77 data Average a = Average { numerator :: !a, denominator :: !Int }
  78
  79 instance Num a => Monoid (Average a) where
  80     mempty = Average 0 0
  81     mappend (Average xL nL) (Average xR nR) = Average (xL + xR) (nL + nR)
  82
  83 average :: Fractional a => Fold a a
  84 average = Fold tally summarize
  85     where
  86         tally x = Average x 1
  87         summarize (Average numerator denominator) =
  88             numerator / fromIntegral denominator