]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/Aggregates/Fis.hs
[FIX] heads.
[gargantext.git] / src / Gargantext / Viz / Phylo / Aggregates / Fis.hs
1 {-|
2 Module : Gargantext.Viz.Phylo.Tools
3 Description : Phylomemy Tools to build/manage it
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10
11 -}
12
13 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE OverloadedStrings #-}
16
17 module Gargantext.Viz.Phylo.Aggregates.Fis
18 where
19
20 import Data.List (null)
21 import Data.Map (Map, empty)
22 import Data.Tuple (fst, snd)
23 import Gargantext.Prelude
24 import Gargantext.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, Size(..))
25 import Gargantext.Viz.Phylo
26 import Gargantext.Viz.Phylo.Tools
27 import qualified Data.Map as Map
28
29
30 -- | To Filter Fis by support
31 filterFisBySupport :: Bool -> Int -> Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
32 filterFisBySupport keep min' m = case keep of
33 False -> Map.map (\l -> filterMinorFis min' l) m
34 True -> Map.map (\l -> keepFilled (filterMinorFis) min' l) m
35
36
37 -- | To filter Fis with small Support, to preserve nonempty periods please use : filterFisBySupport true
38 filterMinorFis :: Int -> [PhyloFis] -> [PhyloFis]
39 filterMinorFis min' l = filter (\fis -> getSupport fis > min') l
40
41
42 -- | To filter nested Fis
43 filterFisByNested :: Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
44 filterFisByNested = map (\l -> let cliqueMax = filterNestedSets (head' "Fis" $ map getClique l) (map getClique l) []
45 in filter (\fis -> elem (getClique fis) cliqueMax) l)
46
47
48 -- | To transform a list of Documents into a Frequent Items Set
49 docsToFis :: Map (Date, Date) [Document] -> Map (Date, Date) [PhyloFis]
50 docsToFis docs = map (\d -> let fs = Map.toList $ fisWithSizePolyMap (Segment 1 20) 1 (map text d)
51 in map (\f -> PhyloFis (fst f) (snd f) empty) fs) docs
52
53
54 -- | To process a list of Filters on top of the PhyloFis
55 processFilters :: [Filter] -> Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
56 processFilters filters phyloFis
57 | null filters = phyloFis
58 | otherwise = panic "[ERR][Viz.Phylo.LevelMaker.processFilters] please add some filters for the Fis"
59
60
61 -- | To process a list of Metrics on top of the PhyloFis
62 processMetrics :: [Metric] -> Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
63 processMetrics metrics phyloFis
64 | null metrics = phyloFis
65 | otherwise = panic "[ERR][Viz.Phylo.LevelMaker.processMetrics] please add some metrics for the Fis"
66
67
68 -- | To transform some Documents into PhyloFis and apply a List of Metrics and Filters
69 toPhyloFis :: Map (Date, Date) [Document] -> Bool -> Support -> [Metric] -> [Filter] -> Map (Date, Date) [PhyloFis]
70 toPhyloFis ds k s ms fs = processFilters fs
71 $ processMetrics ms
72 $ filterFisByNested
73 $ filterFisBySupport k s
74 $ docsToFis ds