]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Viz/Graph/Bridgeness.hs
[MERGE] Upgrading postgresql and ngrams repo changes
[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 TODO use Map LouvainNodeId (Map LouvainNodeId)
15 -}
16
17
18 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
19 where
20
21 import Data.List (concat, sortOn)
22 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
23 import Data.Maybe (catMaybes)
24 import Data.Ord (Down(..))
25 import Gargantext.Prelude
26 import Graph.Types (ClusterNode(..))
27 import qualified Data.Map as DM
28
29
30
31 ----------------------------------------------------------------------
32 type Partitions a = Map (Int, Int) Double -> IO [a]
33 ----------------------------------------------------------------------
34 class ToComId a where
35 nodeId2comId :: a -> (NodeId,CommunityId)
36
37 type NodeId = Int
38 type CommunityId = Int
39
40 ----------------------------------------------------------------------
41 instance ToComId ClusterNode where
42 nodeId2comId (ClusterNode i1 i2) = (i1, i2)
43
44 ----------------------------------------------------------------------
45 ----------------------------------------------------------------------
46 type Bridgeness = Double
47
48 bridgeness :: ToComId a => Bridgeness
49 -> [a]
50 -> Map (NodeId, NodeId) Double
51 -> Map (NodeId, NodeId) Double
52 bridgeness = bridgeness' nodeId2comId
53
54
55 bridgeness' :: (a -> (Int, Int))
56 -> Bridgeness
57 -> [a]
58 -> Map (Int, Int) Double
59 -> Map (Int, Int) Double
60 bridgeness' f b ns = DM.fromList
61 . concat
62 . DM.elems
63 . filterComs b
64 . groupEdges (DM.fromList $ map f ns)
65
66
67 groupEdges :: (Ord a, Ord b1)
68 => Map b1 a
69 -> Map (b1, b1) b2
70 -> Map (a, a) [((b1, b1), b2)]
71 groupEdges m = fromListWith (<>)
72 . catMaybes
73 . map (\((n1,n2), d)
74 -> let
75 n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
76 n1n2_d = Just [((n1,n2),d)]
77 in (,) <$> n1n2_m <*> n1n2_d
78 )
79 . toList
80
81 -- | TODO : sortOn Confluence
82 filterComs :: (Ord n1, Eq n2)
83 => p
84 -> Map (n2, n2) [(a3, n1)]
85 -> Map (n2, n2) [(a3, n1)]
86 filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
87 where
88 filter' (c1,c2) a
89 | c1 == c2 = a
90 -- TODO use n here
91 | otherwise = take 1 $ sortOn (Down . snd) a
92 where
93 _n :: Int
94 _n = round $ 100 * a' / t
95 a'= fromIntegral $ length a
96 t :: Double
97 t = fromIntegral $ length $ concat $ elems m