src/Gargantext/Utils/Count_hs

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