]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/Bridgeness.hs
[FIX] merge dev-phylo and dev
[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
20
21 -}
22
23
24 module Gargantext.Viz.Graph.Bridgeness (bridgeness)
25 where
26
27 import Data.Ord (Down(..))
28 import Gargantext.Prelude
29 import Data.Map (Map, fromListWith, lookup, fromList, toList, mapWithKey, elems)
30 import qualified Data.Map as DM
31 import Data.Maybe (catMaybes)
32 import Data.List (concat, sortOn)
33 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
34
35
36 -- TODO mv in Louvain Lib
37 type LouvainNodeId = Int
38 type CommunityId = Int
39
40 type Bridgeness = Double
41
42
43 bridgeness :: Bridgeness
44 -> [LouvainNode]
45 -> Map (LouvainNodeId, LouvainNodeId) Double
46 -> Map (LouvainNodeId, LouvainNodeId) Double
47 bridgeness b ns = DM.fromList
48 . concat
49 . DM.elems
50 . filterComs b
51 . groupEdges (nodeId2comId ns)
52
53
54 nodeId2comId :: [LouvainNode] -> Map LouvainNodeId CommunityId
55 nodeId2comId ns = fromList [(nId,cId) | LouvainNode nId cId <- ns]
56
57
58 groupEdges :: Map LouvainNodeId CommunityId
59 -> Map (LouvainNodeId, LouvainNodeId) Double
60 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
61 groupEdges m = fromListWith (<>)
62 . catMaybes
63 . map (\((n1,n2), d)
64 -> let
65 n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
66 n1n2_d = Just [((n1,n2),d)]
67 in (,) <$> n1n2_m <*> n1n2_d
68 )
69 . toList
70
71 -- | TODO : sortOn Confluence
72 filterComs :: Bridgeness
73 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
74 -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
75 filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
76 where
77 filter' (c1,c2) a
78 | c1 == c2 = a
79 -- TODO use n here
80 | otherwise = take 1 $ sortOn (Down . snd) a
81 where
82 _n :: Int
83 _n = round $ 100 * a' / t
84 a'= fromIntegral $ length a
85 t :: Double
86 t = fromIntegral $ length $ concat $ elems m
87