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 {-# LANGUAGE BangPatterns #-}
  18
  19 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
  20   where
  21
  22 import Data.List (concat, sortOn)
  23 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
  24 import Data.Maybe (catMaybes, fromMaybe)
  25 import Data.Set (Set)
  26 import Gargantext.Prelude
  27 import Graph.Types (ClusterNode(..))
  28 import Data.Ord (Down(..))
  29 import qualified Data.List as List
  30 import qualified Data.Map  as Map
  31 import qualified Data.Set  as Set
  32
  33 ----------------------------------------------------------------------
  34 type Partitions a = Map (Int, Int) Double -> IO [a]
  35 ----------------------------------------------------------------------
  36 class ToComId a where
  37   nodeId2comId :: a -> (NodeId,CommunityId)
  38
  39 type NodeId        = Int
  40 type CommunityId   = Int
  41
  42 ----------------------------------------------------------------------
  43 instance ToComId ClusterNode where
  44   nodeId2comId (ClusterNode i1 i2) = (i1, i2)
  45
  46 ----------------------------------------------------------------------
  47 ----------------------------------------------------------------------
  48 type Bridgeness = Double
  49 type Confluence = Map (NodeId, NodeId) Double
  50
  51 bridgeness3 :: Confluence
  52            -> Map (NodeId, NodeId) Double
  53            -> Map (NodeId, NodeId) Double
  54 bridgeness3 _ m = m
  55
  56
  57 bridgeness2 :: Confluence
  58            -> Map (NodeId, NodeId) Double
  59            -> Map (NodeId, NodeId) Double
  60 bridgeness2 c m = Map.fromList
  61                 $ List.filter (\((k1,k2),_v) -> if k1 > k2
  62                                                    then fromMaybe False (Set.member k2 <$> Map.lookup k1 toKeep)
  63                                                    else fromMaybe False (Set.member k1 <$> Map.lookup k2 toKeep)
  64                                )
  65                 $ m'
  66   where
  67     toKeep :: Map NodeId (Set NodeId)
  68     !toKeep = Map.fromListWith (<>)
  69             $ map (\((k1,k2), _v) -> if k1 > k2
  70                                         then (k1, Set.singleton k2)
  71                                         else (k2, Set.singleton k1)
  72                   )
  73             $ List.take n
  74             $ List.sortOn (Down . snd)
  75             $ Map.toList c
  76
  77     !m' = Map.toList m
  78     n :: Int
  79     !n = round $ (fromIntegral $ List.length m') / (2 :: Double)
  80
  81 {-
  82     n :: Int
  83     n = Set.size $ Set.fromList $ as <> bs
  84       where
  85         (as, bs) = List.unzip $ Map.keys m
  86 -}
  87
  88 bridgeness :: ToComId a
  89            => Confluence
  90            -> [a]
  91            -> Map (NodeId, NodeId) Double
  92            -> Map (NodeId, NodeId) Double
  93 bridgeness = bridgenessWith nodeId2comId
  94   where
  95     bridgenessWith :: (a -> (Int, Int))
  96                -> Confluence
  97                -> [a]
  98                -> Map (Int, Int) Double
  99                -> Map (Int, Int) Double
 100     bridgenessWith f b ns = Map.fromList
 101                            . concat
 102                            . Map.elems
 103                            . filterComs b
 104                            . groupEdges (Map.fromList $ map f ns)
 105
 106
 107 groupEdges :: (Ord a, Ord b1)
 108            => Map b1 a
 109            -> Map (b1, b1) b2
 110            -> Map (a, a) [((b1, b1), b2)]
 111 groupEdges m = fromListWith (<>)
 112              . catMaybes
 113              . map (\((n1,n2), d)
 114                      -> let
 115                           n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
 116                           n1n2_d = Just [((n1,n2),d)]
 117                         in (,) <$> n1n2_m <*> n1n2_d
 118                     )
 119              . toList
 120
 121 -- | TODO : sortOn Confluence
 122 filterComs :: (Ord n1, Eq n2)
 123            => p
 124            -> Map (n2, n2) [(a3, n1)]
 125            -> Map (n2, n2) [(a3, n1)]
 126 filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
 127   where
 128     filter' (c1,c2) a
 129       | c1 == c2  = a
 130       -- TODO use n here
 131       | otherwise = take 1 $ sortOn (Down . snd) a
 132            where
 133             _n :: Int
 134             _n = round $ 100 * a' / t
 135             a'= fromIntegral $ length a
 136             t :: Double
 137             t = fromIntegral $ length $ concat $ elems m
 138
 139 --------------------------------------------------------------
 140
 141 {--
 142 Compute the median of a list
 143 From:  https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
 144 Compute the center of the list in a more lazy manner
 145 and thus halves memory requirement.
 146 -}
 147 median :: (Ord a, Fractional a) => [a] -> a
 148 median [] = panic "medianFast: empty list has no median"
 149 median zs =
 150    let recurse (x0:_)    (_:[])   = x0
 151        recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
 152        recurse (_:xs)    (_:_:ys) = recurse xs ys
 153        recurse _ _  =
 154           panic "median: this error cannot occur in the way 'recurse' is called"
 155    in  recurse zs zs
 156