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