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