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
13 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE OverloadedStrings #-}
17 module Gargantext.Viz.Phylo.Metrics.Clustering
20 import Data.List (last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!))
21 import Data.Map (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys)
23 import Data.Tuple (fst, snd)
25 import Data.Graph.Clustering.Louvain.CplusPlus
27 import Gargantext.Prelude hiding (head)
28 import Gargantext.Viz.Phylo
29 import Gargantext.Viz.Phylo.Tools
31 import qualified Data.List as List
32 import qualified Data.Map as Map
33 import qualified Data.Set as Set
36 -- | To apply the related components method to a PhyloGraph
37 -- curr = the current PhyloGroup
38 -- (nodes,edges) = the initial PhyloGraph minus the current PhyloGroup
39 -- next = the next PhyloGroups to be added in the cluster
40 -- memo = the memory of the allready created clusters
41 relatedComp :: Int -> PhyloGroup -> PhyloGraph -> [PhyloGroup] -> [[PhyloGroup]] -> [[PhyloGroup]]
42 relatedComp idx curr (nodes,edges) next memo
43 | null nodes' && null next' = memo'
44 | (not . null) next' = relatedComp idx (head next') (nodes',edges) (tail next') memo'
45 | otherwise = relatedComp (idx + 1) (head nodes') (tail nodes',edges) [] memo'
47 --------------------------------------
48 memo' :: [[PhyloGroup]]
50 | null memo = [[curr]]
51 | idx == ((length memo) - 1) = (init memo) ++ [(last memo) ++ [curr]]
52 | otherwise = memo ++ [[curr]]
53 --------------------------------------
55 next' = filter (\x -> not $ elem x $ concat memo) $ nub $ next ++ (getNeighbours False curr edges)
56 --------------------------------------
57 nodes' :: [PhyloGroup]
58 nodes' = filter (\x -> not $ elem x next') nodes
59 --------------------------------------
62 louvain :: (PhyloNodes,PhyloEdges) -> [Cluster]
63 louvain (nodes,edges) = undefined
65 -- louvain :: (PhyloNodes,PhyloEdges) -> [Cluster]
66 -- louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community)
67 -- $ groupBy (l_community_id)
69 -- $ mapKeys (\(x,y) -> (idx x, idx y))
72 -- --------------------------------------
73 -- idx :: PhyloGroup -> Int
74 -- idx e = case elemIndex e nodes of
75 -- Nothing -> panic "[ERR][Gargantext.Viz.Phylo.Metrics.Clustering] a node is missing"
77 -- --------------------------------------