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