]> Git — Sourcephile - gargantext.git/blob - src/Data/Gargantext/Utils/Count_hs
[PATH] Data.Gargantext -> Gargantext.
[gargantext.git] / 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