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