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        (last,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!))
  22 import Data.Map         (fromList,mapKeys)
  23 import Gargantext.Prelude
  24 import Gargantext.Viz.Phylo
  25 import Gargantext.Viz.Phylo.Tools
  26
  27 -- | To apply the related components method to a PhyloGraph
  28 -- curr = the current PhyloGroup
  29 -- (nodes,edges) = the initial PhyloGraph minus the current PhyloGroup
  30 -- next = the next PhyloGroups to be added in the cluster
  31 -- memo = the memory of the allready created clusters
  32 relatedComp :: Int -> PhyloGroup -> GroupGraph -> [PhyloGroup] -> [[PhyloGroup]] -> [[PhyloGroup]]
  33 relatedComp idx curr (nodes,edges) next memo
  34   | null nodes' && null next' = memo'
  35   | (not . null) next'        = relatedComp  idx      (head' "relatedComp1" next' ) (nodes'     ,edges) (tail next') memo'
  36   | otherwise                 = relatedComp (idx + 1) (head' "relatedComp2" nodes') (tail nodes',edges) []           memo'
  37   where
  38     --------------------------------------
  39     memo' :: [[PhyloGroup]]
  40     memo'
  41       | null memo                  = [[curr]]
  42       | idx == ((length memo) - 1) = (init memo) ++ [(last memo) ++ [curr]]
  43       | otherwise                  = memo ++ [[curr]]
  44     --------------------------------------
  45     next' :: [PhyloGroup]
  46     next' = filter (\x -> not $ elem x $ concat memo) $ nub $ next ++ (getNeighbours True curr edges)
  47     --------------------------------------
  48     nodes' :: [PhyloGroup]
  49     nodes' = filter (\x -> not $ elem x next') nodes
  50     --------------------------------------
  51
  52
  53 louvain :: (GroupNodes,GroupEdges) -> IO [[PhyloGroup]]
  54 louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community)
  55                       <$> groupBy (\a b -> (l_community_id a) == (l_community_id b))
  56                       <$> (cLouvain $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges)
  57   where
  58     --------------------------------------
  59     idx :: PhyloGroup -> Int
  60     idx e = case elemIndex e nodes of
  61       Nothing -> panic "[ERR][Gargantext.Viz.Phylo.Metrics.Clustering] a node is missing"
  62       Just i  -> i
  63     --------------------------------------