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 Data.List        (null,tail)
  21 import Data.Map         (Map)
  22 import Data.Tuple       (fst)
  23 import Gargantext.Prelude
  24 import Gargantext.Viz.Phylo
  25 import Gargantext.Viz.Phylo.Tools
  26 import Gargantext.Viz.Phylo.BranchMaker
  27 import Gargantext.Viz.Phylo.Metrics.Clustering
  28 import qualified Data.Map    as Map
  29
  30
  31 -- | To apply a Clustering method to a PhyloGraph
  32 graphToClusters :: Cluster -> GroupGraph -> [PhyloCluster]
  33 graphToClusters clust (nodes,edges) = case clust of
  34   Louvain (LouvainParams _)      -> undefined -- louvain (nodes,edges)
  35   RelatedComponents (RCParams _) -> relatedComp 0 (head' "graphToClusters" nodes) (tail nodes,edges) [] []
  36   _                              -> panic "[ERR][Viz.Phylo.Aggregates.Cluster.graphToClusters] not implemented"
  37
  38 -- | To transform a Phylo into Clusters of PhyloGroups at a given level
  39 phyloToClusters :: Level -> Proximity -> Cluster -> Phylo -> Map (Date,Date) [PhyloCluster]
  40 phyloToClusters lvl prox clus p = Map.fromList
  41                                 $ zip (getPhyloPeriods p)
  42                                    (map (\prd -> let graph = groupsToGraph prox (getGroupsWithFilters lvl prd p) p
  43                                                  in if null (fst graph)
  44                                                     then []
  45                                                     else graphToClusters clus graph)
  46                                    (getPhyloPeriods p))