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