]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/Metrics/Clustering.hs
starting working on output views
[gargantext.git] / 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.List (last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!))
21 import Data.Map (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys)
22 import Data.Set (Set)
23 import Data.Tuple (fst, snd)
24
25 import Data.Graph.Clustering.Louvain.CplusPlus
26
27 import Gargantext.Prelude hiding (head)
28 import Gargantext.Viz.Phylo
29 import Gargantext.Viz.Phylo.Tools
30
31 import qualified Data.List as List
32 import qualified Data.Map as Map
33 import qualified Data.Set as Set
34
35
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'
46 where
47 --------------------------------------
48 memo' :: [[PhyloGroup]]
49 memo'
50 | null memo = [[curr]]
51 | idx == ((length memo) - 1) = (init memo) ++ [(last memo) ++ [curr]]
52 | otherwise = memo ++ [[curr]]
53 --------------------------------------
54 next' :: [PhyloGroup]
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 --------------------------------------
60
61
62 louvain :: (PhyloNodes,PhyloEdges) -> [Cluster]
63 louvain (nodes,edges) = undefined
64
65 -- louvain :: (PhyloNodes,PhyloEdges) -> [Cluster]
66 -- louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community)
67 -- $ groupBy (l_community_id)
68 -- $ cLouvain
69 -- $ mapKeys (\(x,y) -> (idx x, idx y))
70 -- $ fromList edges
71 -- where
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"
76 -- Just i -> i
77 -- --------------------------------------