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        (last,head,null)
  21 import Data.Map         (Map, empty)
  22 import Data.Text        (Text, unwords, toLower, words)
  23 import Data.Tuple       (fst, snd)
  24 import Data.Tuple.Extra
  25 import Data.Vector      (Vector)
  26
  27 import Gargantext.Prelude                       hiding (head)
  28 import Gargantext.Text.Metrics.FrequentItemSet  (fisWithSizePolyMap, Size(..))
  29 import Gargantext.Text.Terms.Mono               (monoTexts)
  30 import Gargantext.Viz.Phylo
  31 import Gargantext.Viz.Phylo.Tools
  32
  33 import qualified Data.List   as List
  34 import qualified Data.Map    as Map
  35 import qualified Data.Vector as Vector
  36
  37
  38 -- | To Filter Fis by support
  39 filterFisBySupport :: Bool -> Int -> Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
  40 filterFisBySupport keep min m = case keep of
  41   False -> Map.map (\l -> filterMinorFis min l) m
  42   True  -> Map.map (\l -> keepFilled (filterMinorFis) min l) m
  43
  44
  45 -- | To filter Fis with small Support, to preserve nonempty periods please use : filterFisBySupport true
  46 filterMinorFis :: Int -> [PhyloFis] -> [PhyloFis]
  47 filterMinorFis min l = filter (\fis -> getSupport fis > min) l
  48
  49
  50 -- | To filter nested Fis
  51 filterFisByNested :: Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
  52 filterFisByNested = map (\l -> let cliqueMax = filterNestedSets (head $ map getClique l) (map getClique l) []
  53                                in  filter (\fis -> elem (getClique fis) cliqueMax) l)
  54
  55
  56 -- | To transform a list of Documents into a Frequent Items Set
  57 docsToFis :: Map (Date, Date) [Document] -> Map (Date, Date) [PhyloFis]
  58 docsToFis docs = map (\d -> let fs = Map.toList $ fisWithSizePolyMap (Segment 1 20) 1 (map text d)
  59                             in map (\f -> PhyloFis (fst f) (snd f) empty) fs) docs
  60
  61
  62 -- | To process a list of Filters on top of the PhyloFis
  63 processFilters :: [Filter] -> Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
  64 processFilters filters phyloFis
  65   | null filters = phyloFis
  66   | otherwise    = panic "[ERR][Viz.Phylo.LevelMaker.processFilters] please add some filters for the Fis"
  67
  68
  69 -- | To process a list of Metrics on top of the PhyloFis
  70 processMetrics :: [Metric] -> Map (Date, Date) [PhyloFis] -> Map (Date, Date) [PhyloFis]
  71 processMetrics metrics phyloFis
  72   | null metrics = phyloFis
  73   | otherwise    = panic "[ERR][Viz.Phylo.LevelMaker.processMetrics] please add some metrics for the Fis"
  74
  75
  76 -- | To transform some Documents into PhyloFis and apply a List of Metrics and Filters
  77 toPhyloFis :: Map (Date, Date) [Document] -> Bool -> Support -> [Metric] -> [Filter] -> Map (Date, Date) [PhyloFis]
  78 toPhyloFis ds k s ms fs = processFilters fs
  79                         $ processMetrics ms
  80                         $ filterFisByNested
  81                         $ filterFisBySupport k s
  82                         $ docsToFis ds