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 Debug.Trace (trace)
  23 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
  24 import Data.Maybe (catMaybes)
  25 import Gargantext.Prelude
  26 import Graph.Types (ClusterNode(..))
  27 import Data.Ord (Down(..))
  28 import Data.IntMap (IntMap)
  29 import qualified Data.IntMap as IntMap
  30 import qualified Data.List   as List
  31 import qualified Data.Map    as Map
  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
  52 bridgeness3 :: Confluence
  53            -> Map (NodeId, NodeId) Double
  54            -> Map (NodeId, NodeId) Double
  55 bridgeness3 c m = trace ("bridgeness c' size: " <> (show $ List.length c'))
  56                 $ Map.fromList
  57                 $ map (\(ks, (v1,_v2)) -> (ks,v1))
  58                 $ List.take n
  59      --           $ List.sortOn (Down . (snd . snd))
  60                 $ Map.toList c'
  61   where
  62     -- !c' = map2intMap c
  63     !c' = Map.intersectionWithKey (\_k v1 v2 -> (v1, v2)) m c
  64     !m' = Map.toList m
  65
  66     n :: Int
  67     !n = trace ("bridgeness m size: " <> (show $ List.length m'))
  68        $ round
  69        $ (fromIntegral $ List.length m') / (10 :: Double)
  70
  71
  72 map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
  73 map2intMap m = IntMap.fromListWith (<>)
  74              $ map (\((k1,k2), v) -> if k1 < k2
  75                                    then (k1, IntMap.singleton k2 v)
  76                                    else (k2, IntMap.singleton k1 v)
  77                     )
  78              $ Map.toList m
  79
  80 look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
  81 look (k1,k2) m = if k1 < k2
  82                     then case (IntMap.lookup k1 m) of
  83                            Just m' -> IntMap.lookup k2 m'
  84                            _       -> Nothing
  85                     else look (k2,k1) m
  86
  87
  88 {-
  89     n :: Int
  90     n = Set.size $ Set.fromList $ as <> bs
  91       where
  92         (as, bs) = List.unzip $ Map.keys m
  93 -}
  94
  95 bridgeness :: ToComId a
  96            => Confluence
  97            -> [a]
  98            -> Map (NodeId, NodeId) Double
  99            -> Map (NodeId, NodeId) Double
 100 bridgeness = bridgenessWith nodeId2comId
 101   where
 102     bridgenessWith :: (a -> (Int, Int))
 103                -> Confluence
 104                -> [a]
 105                -> Map (Int, Int) Double
 106                -> Map (Int, Int) Double
 107     bridgenessWith f b ns = Map.fromList
 108                            . List.concat
 109                            . Map.elems
 110                            . filterComs b
 111                            . groupEdges (Map.fromList $ map f ns)
 112
 113
 114 groupEdges :: (Ord a, Ord b1)
 115            => Map b1 a
 116            -> Map (b1, b1) b2
 117            -> Map (a, a) [((b1, b1), b2)]
 118 groupEdges m = fromListWith (<>)
 119              . catMaybes
 120              . map (\((n1,n2), d)
 121                      -> let
 122                           n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
 123                           n1n2_d = Just [((n1,n2),d)]
 124                         in (,) <$> n1n2_m <*> n1n2_d
 125                     )
 126              . toList
 127
 128 -- | TODO : sortOn Confluence
 129 filterComs :: (Ord n1, Eq n2)
 130            => p
 131            -> Map (n2, n2) [(a3, n1)]
 132            -> Map (n2, n2) [(a3, n1)]
 133 filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
 134   where
 135     filter' (c1,c2) a
 136       | c1 == c2  = a
 137       -- TODO use n here
 138       | otherwise = take 1 $ List.sortOn (Down . snd) a
 139            where
 140             _n :: Int
 141             _n = round $ 100 * a' / t
 142             a'= fromIntegral $ length a
 143             t :: Double
 144             t = fromIntegral $ length $ List.concat $ elems m
 145
 146 --------------------------------------------------------------
 147
 148 {--
 149 Compute the median of a list
 150 From:  https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
 151 Compute the center of the list in a more lazy manner
 152 and thus halves memory requirement.
 153 -}
 154 median :: (Ord a, Fractional a) => [a] -> a
 155 median [] = panic "medianFast: empty list has no median"
 156 median zs =
 157    let recurse (x0:_)    (_:[])   = x0
 158        recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
 159        recurse (_:xs)    (_:_:ys) = recurse xs ys
 160        recurse _ _  =
 161           panic "median: this error cannot occur in the way 'recurse' is called"
 162    in  recurse zs zs
 163