]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/Bridgeness.hs
Merge branch 'dev-doc-table-optimization' of ssh://gitlab.iscpif.fr:20022/gargantext...
[gargantext.git] / src / Gargantext / Viz / Graph / Bridgeness.hs
1 {-|
2 Module : Gargantext.Viz.Graph.Bridgeness
3 Description : Bridgeness filter
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
11 filters inter-communities links.
12
13 TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
14
15 TODO use Map LouvainNodeId (Map LouvainNodeId)
16 -}
17
18
19 module Gargantext.Viz.Graph.Bridgeness (bridgeness)
20 where
21
22 import Data.Ord (Down(..))
23 import Gargantext.Prelude
24 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
25 import qualified Data.Map as DM
26 import Data.Maybe (catMaybes)
27 import Data.List (concat, sortOn)
28 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
29 import Gargantext.Viz.Graph.Louvain (LouvainNodeId, CommunityId, nodeId2comId)
30
31
32 type Bridgeness = Double
33
34
35 bridgeness :: Bridgeness
36 -> [LouvainNode]
37 -> Map (LouvainNodeId, LouvainNodeId) Double
38 -> Map (LouvainNodeId, LouvainNodeId) Double
39 bridgeness b ns = DM.fromList
40 . concat
41 . DM.elems
42 . filterComs b
43 . groupEdges (nodeId2comId ns)
44
45 groupEdges :: Map LouvainNodeId CommunityId
46 -> Map (LouvainNodeId, LouvainNodeId) Double
47 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
48 groupEdges m = fromListWith (<>)
49 . catMaybes
50 . map (\((n1,n2), d)
51 -> let
52 n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
53 n1n2_d = Just [((n1,n2),d)]
54 in (,) <$> n1n2_m <*> n1n2_d
55 )
56 . toList
57
58 -- | TODO : sortOn Confluence
59 filterComs :: Bridgeness
60 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
61 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
62 filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
63 where
64 filter' (c1,c2) a
65 | c1 == c2 = a
66 -- TODO use n here
67 | otherwise = take 1 $ sortOn (Down . snd) a
68 where
69 _n :: Int
70 _n = round $ 100 * a' / t
71 a'= fromIntegral $ length a
72 t :: Double
73 t = fromIntegral $ length $ concat $ elems m