src/Gargantext/Viz/Phylo/Aggregates/Cooc.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.Cooc
  18   where
  19
  20 import Data.List        (union,concat,nub)
  21 import Data.Map         (Map,elems,adjust,filterWithKey)
  22 import Gargantext.Prelude
  23 import Gargantext.Viz.Phylo
  24 import Gargantext.Viz.Phylo.Tools
  25 import qualified Data.Map    as Map
  26 import qualified Data.Set    as Set
  27
  28
  29 -- | To transform the Fis into a full coocurency Matrix in a Phylo
  30 fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
  31 fisToCooc m p = map (/docs)
  32               $ foldl (\mem x -> adjust (+1) x mem) cooc
  33               $ concat
  34               $ map (\x -> listToDirectedCombiWith (\y -> getIdxInRoots y p) $ (Set.toList . getClique) x)
  35               $ (concat . elems) m
  36   where
  37     --------------------------------------
  38     fisNgrams :: [Ngrams]
  39     fisNgrams = foldl (\mem x -> union mem $ (Set.toList . getClique) x) [] $ (concat . elems) m
  40     --------------------------------------
  41     docs :: Double
  42     docs = fromIntegral $ foldl (\mem x -> mem + (getSupport x)) 0 $ (concat . elems) m
  43     --------------------------------------
  44     cooc :: Map (Int, Int) (Double)
  45     cooc = Map.fromList $ map (\x -> (x,0)) (listToDirectedCombiWith (\y -> getIdxInRoots y p) fisNgrams)
  46     --------------------------------------
  47
  48
  49
  50 -- | To transform a tuple of group's information into a coocurency Matrix
  51 toCooc :: [([Int],Double)] -> Map (Int, Int) Double
  52 toCooc l = map (/docs)
  53          $ foldl (\mem x -> adjust (+1) x mem) cooc
  54          $ concat
  55          $ map (\x -> listToFullCombi $ fst x) l
  56   where
  57     --------------------------------------
  58     idx :: [Int]
  59     idx = nub $ concat $ map fst l
  60     --------------------------------------
  61     docs :: Double
  62     docs = sum $ map snd l
  63     --------------------------------------
  64     cooc :: Map (Int, Int) (Double)
  65     cooc = Map.fromList $ map (\x -> (x,0)) $ listToFullCombi idx
  66     --------------------------------------
  67
  68
  69 -- | To reduce a coocurency Matrix to some keys
  70 getSubCooc :: [Int] -> Map (Int, Int) Double -> Map (Int, Int) Double
  71 getSubCooc idx cooc = filterWithKey (\k _ -> (elem (fst k) idx)
  72                                           && (elem (snd k) idx)) cooc
  73
  74
  75 -- | To get a coocurency Matrix related to a given list of Periods
  76 getCooc :: [PhyloPeriodId] -> Phylo -> Map (Int, Int) Double
  77 getCooc prds p = toCooc $ map (\g -> (getGroupNgrams g,getGroupMeta "support" g)) gs
  78   where
  79     --------------------------------------
  80     -- | Here we need to go back to the level 1 (aka : the Fis level)
  81     gs :: [PhyloGroup]
  82     gs = filter (\g -> elem (getGroupPeriod g) prds ) $ getGroupsWithLevel 1 p
  83     --------------------------------------
  84
  85
  86 -- phyloCooc :: Map (Int, Int) Double
  87 -- phyloCooc = fisToCooc phyloFis phylo1_0_1