]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/Aggregates/Cluster.hs
add a toPhylo function and the foundation of the Rest routes
[gargantext.git] / src / Gargantext / Viz / Phylo / Aggregates / Cluster.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.Cluster
18 where
19
20 import Control.Lens hiding (makeLenses, both, Level)
21
22 import Data.List (last,head,union,concat,null,nub,(++),init,tail,(!!))
23 import Data.Map (Map,elems,adjust,unionWith,intersectionWith)
24 import Data.Set (Set)
25 import Data.Tuple (fst, snd)
26
27 import Gargantext.Prelude hiding (head)
28 import Gargantext.Viz.Phylo
29 import Gargantext.Viz.Phylo.Tools
30 import Gargantext.Viz.Phylo.BranchMaker
31 import Gargantext.Viz.Phylo.Metrics.Proximity
32 import Gargantext.Viz.Phylo.Metrics.Clustering
33
34 import qualified Data.List as List
35 import qualified Data.Map as Map
36 import qualified Data.Set as Set
37
38
39 -- | To apply a Clustering method to a PhyloGraph
40 graphToClusters :: Clustering -> GroupGraph -> [Cluster]
41 graphToClusters clust (nodes,edges) = case clust ^. clustering_name of
42 Louvain -> undefined -- louvain (nodes,edges)
43 RelatedComponents -> relatedComp 0 (head nodes) (tail nodes,edges) [] []
44
45
46 -- | To transform a Phylo into Clusters of PhyloGroups at a given level
47 phyloToClusters :: Level -> Proximity -> Clustering -> Phylo -> Map (Date,Date) [Cluster]
48 phyloToClusters lvl prox clus p = Map.fromList
49 $ zip (getPhyloPeriods p)
50 (map (\prd -> let graph = groupsToGraph prox (getGroupsWithFilters lvl prd p) p
51 in if null (fst graph)
52 then []
53 else graphToClusters clus graph)
54 (getPhyloPeriods p))