src/Data/Gargantext/Utils/Count_hs

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