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
  14 -}
  15
  16 {-# LANGUAGE NoImplicitPrelude #-}
  17
  18 module Gargantext.Viz.Graph.Bridgeness (bridgeness)
  19   where
  20 --import GHC.Base (Semigroup)
  21 import Gargantext.Prelude
  22 --import Data.Tuple.Extra (swap)
  23 --import Gargantext.Viz.Graph
  24 import Data.Map (Map, fromListWith, lookup, fromList, delete, toList, mapKeys, mapWithKey, elems)
  25 import qualified Data.Map as DM
  26 import Data.Maybe (fromJust)
  27 import Data.List (concat, sortOn)
  28 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
  29
  30
  31 -- TODO mv in Louvain Lib
  32 type LouvainNodeId = Int
  33 type CommunityId   = Int
  34
  35 type Bridgeness = Double
  36
  37
  38 bridgeness :: Bridgeness
  39            -> [LouvainNode]
  40            -> Map (LouvainNodeId, LouvainNodeId) Double
  41            -> Map (LouvainNodeId, LouvainNodeId) Double
  42 bridgeness b ns = DM.fromList
  43                 . concat
  44                 . DM.elems
  45                 . filterComs b
  46                 . groupEdges (nodeId2comId ns)
  47
  48 nodeId2comId :: [LouvainNode] -> Map LouvainNodeId CommunityId
  49 nodeId2comId ns = fromList [ (nId,cId) | LouvainNode nId cId <- ns]
  50
  51 groupEdges :: Map LouvainNodeId CommunityId
  52            -> Map (LouvainNodeId, LouvainNodeId) Double
  53            -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
  54 groupEdges m = mapKeys fromJust
  55              . delete Nothing
  56              . fromListWith (<>)
  57              . map (\((n1,n2), d)
  58                      -> ((,) <$> lookup n1 m
  59                              <*> lookup n2 m
  60                         , [((n1,n2),d)]
  61                         )
  62                    )
  63              . toList
  64
  65 filterComs :: Bridgeness
  66            -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
  67            -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
  68 filterComs b m = mapWithKey filter' m
  69   where
  70     filter' (c1,c2) a = case c1 == c2 of
  71       True  -> a
  72       False -> take n $ sortOn snd a
  73         where
  74           n = round $ b * a' / t
  75           a'= fromIntegral $ length a
  76           t = fromIntegral $ length $ concat $ elems m
  77
  78