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,concat,sort,intersect)
  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.Metrics.Proximity
  27 import Gargantext.Viz.Phylo.Metrics.Clustering
  28 import Gargantext.Viz.Phylo.Aggregates.Cooc
  29 import qualified Data.Map    as Map
  30
  31 import qualified Data.Vector.Storable as VS
  32 import Debug.Trace (trace)
  33 import Numeric.Statistics (percentile)
  34
  35
  36 -- | Optimisation to filter only relevant candidates
  37 getCandidates :: [PhyloGroup] -> [(PhyloGroup,PhyloGroup)]
  38 getCandidates gs = filter (\(g,g') -> (not . null) $ intersect (getGroupNgrams g) (getGroupNgrams g'))
  39                  $ filter (\(g,g') -> g /= g')
  40                  $ listToDirectedCombi gs
  41
  42
  43 -- | To transform a Graph into Clusters
  44 graphToClusters :: Cluster -> GroupGraph -> [PhyloCluster]
  45 graphToClusters clust (nodes,edges) = case clust of
  46       Louvain (LouvainParams _)      -> undefined
  47       RelatedComponents (RCParams _) -> relatedComp 0 (head' "graphToClusters" nodes) (tail nodes,edges) [] []
  48       _                              -> panic "[ERR][Viz.Phylo.Aggregates.Cluster.graphToClusters] not implemented"
  49
  50
  51 -- | To transform a list of PhyloGroups into a Graph of Proximity
  52 groupsToGraph :: Proximity -> [PhyloGroup] -> Map (Int, Int) Double -> ([GroupNode],[GroupEdge])
  53 groupsToGraph prox gs cooc = case prox of
  54       WeightedLogJaccard (WLJParams _ sens) -> (gs, map (\(x,y) -> ((x,y), weightedLogJaccard sens (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
  55                                                                          $ getCandidates gs)
  56       Hamming (HammingParams _)             -> (gs, map (\(x,y) -> ((x,y), hamming (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
  57                                                                          $ getCandidates gs)
  58       _                                     -> undefined
  59
  60
  61 -- | To filter a Graph of Proximity using a given threshold
  62 filterGraph :: Proximity -> ([GroupNode],[GroupEdge]) -> ([GroupNode],[GroupEdge])
  63 filterGraph prox (ns,es) = case prox of
  64       WeightedLogJaccard (WLJParams thr _) -> (ns, filter (\(_,v) -> v >= thr) es)
  65       Hamming (HammingParams thr)          -> (ns, filter (\(_,v) -> v <= thr) es)
  66       _                                    -> undefined
  67
  68
  69 -- | To clusterise a Phylo
  70 phyloToClusters :: Level -> Cluster -> Phylo -> Map (Date,Date) [PhyloCluster]
  71 phyloToClusters lvl clus p = Map.fromList
  72                             $ zip periods
  73                             $ map (\g -> if null (fst g)
  74                                          then []
  75                                          else graphToClusters clus g) graphs'
  76   where
  77     --------------------------------------
  78     graphs' :: [([GroupNode],[GroupEdge])]
  79     graphs' = traceGraphFiltered lvl
  80             $ map (\g -> filterGraph prox g) graphs
  81     --------------------------------------
  82     graphs  :: [([GroupNode],[GroupEdge])]
  83     graphs  = traceGraph lvl (getThreshold prox)
  84             $ map (\prd -> groupsToGraph prox (getGroupsWithFilters lvl prd p) (getCooc [prd] p)) periods
  85     --------------------------------------
  86     prox :: Proximity
  87     prox = getProximity clus
  88     --------------------------------------
  89     periods :: [PhyloPeriodId]
  90     periods = getPhyloPeriods p
  91     --------------------------------------
  92
  93
  94 ----------------
  95 -- | Tracer | --
  96 ----------------
  97
  98
  99 traceGraph :: Level -> Double -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
 100 traceGraph lvl thr g = trace ( "----\nUnfiltered clustering in Phylo" <> show (lvl) <> " :\n"
 101                                       <> "count : " <> show (length lst) <> " potential edges (" <> show (length $ filter (>= thr) lst) <> " >= " <> show (thr) <> ")\n"
 102                                       <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
 103                                                          <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
 104                                                          <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
 105                                                          <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") g
 106   where
 107     lst = sort $ map snd $ concat $ map snd g
 108
 109
 110 traceGraphFiltered :: Level -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
 111 traceGraphFiltered lvl g = trace ( "----\nClustering in Phylo" <> show (lvl) <> " :\n"
 112                                       <> "count : " <> show (length lst) <> " edges\n"
 113                                       <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
 114                                                          <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
 115                                                          <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
 116                                                          <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") g
 117   where
 118     lst = sort $ map snd $ concat $ map snd g
 119