src/Gargantext/Viz/Phylo/Metrics/Clustering.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.Metrics.Clustering
  18   where
  19
  20 import Data.Graph.Clustering.Louvain.CplusPlus
  21 import Data.List        (concat,null,nub,(++),elemIndex,groupBy,(!!), (\\), union, intersect)
  22 import Data.Map         (fromList,mapKeys)
  23 import Gargantext.Prelude
  24 import Gargantext.Viz.Phylo
  25
  26 relatedComp :: [[PhyloGroup]] -> [[PhyloGroup]]
  27 relatedComp graphs = foldl' (\mem groups ->
  28   if (null mem)
  29   then mem ++ [groups]
  30   else
  31     let related = filter (\groups' -> (not . null) $ intersect groups groups') mem
  32     in if (null related)
  33        then mem ++ [groups]
  34        else (mem \\ related) ++ [union groups (nub $ concat related)] ) [] graphs
  35
  36
  37 louvain :: ([GroupNode],[GroupEdge]) -> IO [[PhyloGroup]]
  38 louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community)
  39                       <$> groupBy (\a b -> (l_community_id a) == (l_community_id b))
  40                       <$> (cLouvain $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges)
  41   where
  42     --------------------------------------
  43     idx :: PhyloGroup -> Int
  44     idx e = case elemIndex e nodes of
  45       Nothing -> panic "[ERR][Gargantext.Viz.Phylo.Metrics.Clustering] a node is missing"
  46       Just i  -> i
  47     --------------------------------------