]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/SynchronicClustering.hs
Merge branch 'dev-phylo' into dev-merge
[gargantext.git] / src / Gargantext / Viz / Phylo / SynchronicClustering.hs
1 {-|
2 Module : Gargantext.Viz.Phylo.SynchronicClustering
3 Description : Module dedicated to the adaptative synchronic clustering of a Phylo.
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 {-# LANGUAGE NoImplicitPrelude #-}
12 {-# LANGUAGE FlexibleContexts #-}
13 {-# LANGUAGE OverloadedStrings #-}
14 {-# LANGUAGE MultiParamTypeClasses #-}
15
16 module Gargantext.Viz.Phylo.SynchronicClustering where
17
18 import Gargantext.Prelude
19 -- import Gargantext.Viz.AdaptativePhylo
20 -- import Gargantext.Viz.Phylo.PhyloTools
21
22 import Data.List (foldl', (++), null, intersect, (\\), union, nub, concat)
23
24 --------------------
25 -- | Clustering | --
26 --------------------
27
28
29 relatedComponents :: Eq a => [[a]] -> [[a]]
30 relatedComponents graphs = foldl' (\mem groups ->
31 if (null mem)
32 then mem ++ [groups]
33 else
34 let related = filter (\groups' -> (not . null) $ intersect groups groups') mem
35 in if (null related)
36 then mem ++ [groups]
37 else (mem \\ related) ++ [union groups (nub $ concat related)] ) [] graphs