src/Gargantext/Viz/Graph/Bridgeness.hs

   1 {-|
   2 Module      : Gargantext.Viz.Graph.Bridgeness
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10
  11 -}
  12
  13 {-# LANGUAGE NoImplicitPrelude #-}
  14
  15 module Gargantext.Viz.Graph.Bridgeness (bridgeness)
  16   where
  17
  18 import Gargantext.Prelude
  19 --import Gargantext.Viz.Graph
  20 import Data.Map (Map, fromListWith, lookup, fromList, keys)
  21 import Data.Maybe (catMaybes)
  22 import Data.List (sortOn, concat)
  23 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
  24
  25 type Bridgeness = Double
  26
  27 -- TODO mv in Louvain Lib
  28 type LouvainNodeId = Int
  29 type CommunityId   = Int
  30
  31 partition2map :: [LouvainNode] -> Map CommunityId [LouvainNodeId]
  32 partition2map ns = fromListWith (<>) [ (cId, [nId]) | LouvainNode nId cId <- ns]
  33
  34 ordEdgesBetween :: (Ord distance, Ord node)
  35                 => [node] -> [node]
  36                 -> Map (node, node) distance
  37                 -> [((node, node), distance)]
  38 ordEdgesBetween c1 c2 d = reverse $ sortOn snd $ catMaybes
  39               [ (,) <$> Just   (n1,n2)
  40                     <*> lookup (n1,n2) d
  41               | n1 <- c1
  42               , n2 <- c2
  43               , n1 < n2
  44               ]
  45
  46 filterEdgesBetween :: (RealFrac b, Ord node, Ord distance) =>
  47      b -> [node] -> [node]
  48      -> Map (node, node) distance
  49      -> [((node, node), distance)]
  50 filterEdgesBetween b c1 c2 d = take n d'
  51   where
  52     n  = round $ b * i / (s1 + s2)
  53     d' = ordEdgesBetween c1 c2 d
  54     i  = fromIntegral $ length d'
  55     s1 = fromIntegral $ length (ordEdgesBetween c1 c2 d)
  56     s2 = fromIntegral $ length (ordEdgesBetween c2 c2 d)
  57
  58
  59 bridgeness :: Bridgeness
  60            -> [LouvainNode]
  61            -> Map (LouvainNodeId, LouvainNodeId) Double
  62            -> Map (LouvainNodeId, LouvainNodeId) Double
  63 bridgeness b ns' ds = fromList . concat . map (\(c1,c2) -> filterEdgesBetween b c1 c2 ds) $ p
  64   where
  65     p  = catMaybes [ (,) <$> lookup k1 ns <*> lookup k2 ns | k1 <- ks, k2 <- ks, k1 < k2]
  66     ns = partition2map ns'
  67     ks = keys ns
  68
  69
  70