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