]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/Aggregates/Cluster.hs
[DOC] references.
[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 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 -> Phylo -> ([GroupNode],[GroupEdge])
53 groupsToGraph prox gs cooc p = case prox of
54 WeightedLogJaccard (WLJParams _ sens) -> (gs, map (\(x,y) -> ((x,y), traceSim x y (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc) p
55 $ weightedLogJaccard sens (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
56 $ getCandidates gs)
57 Hamming (HammingParams _) -> (gs, map (\(x,y) -> ((x,y), hamming (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
58 $ getCandidates gs)
59 _ -> undefined
60
61
62 -- | To filter a Graph of Proximity using a given threshold
63 filterGraph :: Proximity -> ([GroupNode],[GroupEdge]) -> ([GroupNode],[GroupEdge])
64 filterGraph prox (ns,es) = case prox of
65 WeightedLogJaccard (WLJParams thr _) -> (ns, filter (\(_,v) -> v >= thr) es)
66 Hamming (HammingParams thr) -> (ns, filter (\(_,v) -> v <= thr) es)
67 _ -> undefined
68
69
70 -- | To clusterise a Phylo
71 phyloToClusters :: Level -> Cluster -> Phylo -> Map (Date,Date) [PhyloCluster]
72 phyloToClusters lvl clus p = Map.fromList
73 $ zip periods
74 $ map (\g -> if null (fst g)
75 then []
76 else graphToClusters clus g) graphs'
77 where
78 --------------------------------------
79 graphs' :: [([GroupNode],[GroupEdge])]
80 graphs' = traceGraphFiltered lvl
81 $ map (\g -> filterGraph prox g) graphs
82 --------------------------------------
83 graphs :: [([GroupNode],[GroupEdge])]
84 graphs = traceGraph lvl (getThreshold prox)
85 $ map (\prd -> groupsToGraph prox (getGroupsWithFilters lvl prd p) (getCooc [prd] p) p) periods
86 --------------------------------------
87 prox :: Proximity
88 prox = getProximity clus
89 --------------------------------------
90 periods :: [PhyloPeriodId]
91 periods = getPhyloPeriods p
92 --------------------------------------
93
94
95 ----------------
96 -- | Tracer | --
97 ----------------
98
99
100 traceGraph :: Level -> Double -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
101 traceGraph lvl thr g = trace ( "----\nUnfiltered clustering in Phylo" <> show (lvl) <> " :\n"
102 <> "count : " <> show (length lst) <> " potential edges (" <> show (length $ filter (>= thr) lst) <> " >= " <> show (thr) <> ")\n"
103 <> show (lst) <> "\n"
104 <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
105 <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
106 <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
107 <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") g
108 where
109 lst = sort $ map snd $ concat $ map snd g
110
111
112 traceGraphFiltered :: Level -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
113 traceGraphFiltered lvl g = trace ( "----\nClustering in Phylo" <> show (lvl) <> " :\n"
114 <> "count : " <> show (length lst) <> " edges\n"
115 <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
116 <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
117 <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
118 <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") g
119 where
120 lst = sort $ map snd $ concat $ map snd g
121
122
123 traceSim :: PhyloGroup -> PhyloGroup -> Map (Int, Int) Double -> Map (Int, Int) Double -> Phylo -> Double -> Double
124 traceSim g g' _ _ p sim = trace (show (getGroupText g p) <> " [vs] " <> show (getGroupText g' p) <> " = " <> show (sim) <> "\n"
125 -- <> show (c) <> " [vs] " <> show (c') <> " = " <> show (sim)
126 ) sim