]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Viz/Graph/Bridgeness.hs
Merge branch 'dev-refactor-metrics' of ssh://gitlab.iscpif.fr:20022/gargantext/haskel...
[gargantext.git] / src / Gargantext / Core / Viz / Graph / Bridgeness.hs
1 {-|
2 Module : Gargantext.Core.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.Core.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.Core.Methods.Graph.Louvain (LouvainNodeId, CommunityId, nodeId2comId)
30
31
32 type Bridgeness = Double
33
34 bridgeness :: Bridgeness
35 -> [LouvainNode]
36 -> Map (LouvainNodeId, LouvainNodeId) Double
37 -> Map (LouvainNodeId, LouvainNodeId) Double
38 bridgeness b ns = DM.fromList
39 . concat
40 . DM.elems
41 . filterComs b
42 . groupEdges (nodeId2comId ns)
43
44 groupEdges :: Map LouvainNodeId CommunityId
45 -> Map (LouvainNodeId, LouvainNodeId) Double
46 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
47 groupEdges m = fromListWith (<>)
48 . catMaybes
49 . map (\((n1,n2), d)
50 -> let
51 n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
52 n1n2_d = Just [((n1,n2),d)]
53 in (,) <$> n1n2_m <*> n1n2_d
54 )
55 . toList
56
57 -- | TODO : sortOn Confluence
58 filterComs :: Bridgeness
59 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
60 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
61 filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
62 where
63 filter' (c1,c2) a
64 | c1 == c2 = a
65 -- TODO use n here
66 | otherwise = take 1 $ sortOn (Down . snd) a
67 where
68 _n :: Int
69 _n = round $ 100 * a' / t
70 a'= fromIntegral $ length a
71 t :: Double
72 t = fromIntegral $ length $ concat $ elems m