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        (last,head,union,concat)
  21 import Data.Map         (Map, elems, adjust)
  22 import Data.Set         (Set)
  23 import Data.Tuple       (fst, snd)
  24
  25 import Gargantext.Prelude                       hiding (head)
  26 import Gargantext.Viz.Phylo
  27 import Gargantext.Viz.Phylo.Tools
  28
  29 import qualified Data.List   as List
  30 import qualified Data.Map    as Map
  31 import qualified Data.Set    as Set
  32
  33
  34
  35 -- | To transform the Fis into a coocurency Matrix in a Phylo
  36 fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
  37 fisToCooc m p = map   (/docs)
  38               $ foldl (\mem x -> adjust (+1) (getKeyPair x mem) mem) cooc
  39               $ concat
  40               $ map (\x -> listToUnDirectedCombiWith (\x -> getIdxInPeaks x p) $ (Set.toList . fst) x)
  41               $ (concat . elems) m
  42   where
  43     --------------------------------------
  44     fisNgrams :: [Ngrams]
  45     fisNgrams = foldl (\mem x -> union mem $ (Set.toList . fst) x) [] $ (concat . elems) m
  46     --------------------------------------
  47     docs :: Double
  48     docs = fromIntegral $ foldl (\mem x -> mem + (snd x)) 0 $ (concat . elems) m
  49     --------------------------------------
  50     cooc :: Map (Int, Int) (Double)
  51     cooc = Map.fromList $ map (\x -> (x,0)) (listToUnDirectedCombiWith (\x -> getIdxInPeaks x p) fisNgrams)
  52     --------------------------------------
  53
  54
  55 -- phyloCooc :: Map (Int, Int) Double
  56 -- phyloCooc = fisToCooc phyloFis phylo1_0_1