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 :: QueryClustering -> GroupGraph -> [Cluster]
  41 graphToClusters clust (nodes,edges) = case clust ^. qc_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 -> QueryProximity -> QueryClustering -> 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))