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