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                 $ List.filter (\x -> if sim == Conditional then snd x > 0.2 else snd x > 0.02)
  66                 $ map (\(ks, (v1,_v2)) -> (ks,v1))
  67                 -- $ List.take (if sim == Conditional then 2*n else 3*n)
  68                 -- $ List.sortOn (Down . (snd . snd))
  69                 $ Map.toList
  70                 $ trace ("bridgeness3 m c" <> show (m,c))
  71                 $ Map.intersectionWithKey
  72                       (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2))) (v1, v2)) m c
  73
  74 {-
  75  where
  76     !m' = Map.toList m
  77     n :: Int
  78     !n = trace ("bridgeness m size: " <> (show $ List.length m'))
  79        $ round
  80        $ (fromIntegral $ List.length m') / (log $ fromIntegral nodesNumber :: Double)
  81
  82     nodesNumber :: Int
  83     nodesNumber = Set.size $ Set.fromList $ as <> bs
  84       where
  85         (as, bs) = List.unzip $ Map.keys m
  86 -}
  87
  88
  89 bridgeness (Bridgeness_Basic ns b) m = Map.fromList
  90                                      $ List.concat
  91                                      $ Map.elems
  92                                      $ filterComs b
  93                                      $ groupEdges (Map.fromList $ map nodeId2comId ns) m
  94
  95 groupEdges :: (Ord a, Ord b1)
  96            => Map b1 a
  97            -> Map (b1, b1) b2
  98            -> Map (a, a) [((b1, b1), b2)]
  99 groupEdges m = fromListWith (<>)
 100              . catMaybes
 101              . map (\((n1,n2), d)
 102                      -> let
 103                           n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
 104                           n1n2_d = Just [((n1,n2),d)]
 105                         in (,) <$> n1n2_m <*> n1n2_d
 106                     )
 107              . toList
 108
 109 -- | TODO : sortOn Confluence
 110 filterComs :: (Ord n1, Eq n2)
 111            => p
 112            -> Map (n2, n2) [(a3, n1)]
 113            -> Map (n2, n2) [(a3, n1)]
 114 filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
 115   where
 116     filter' (c1,c2) a
 117       | c1 == c2  = a
 118       -- TODO use n here
 119       | otherwise = take n $ List.sortOn (Down . snd) a
 120            where
 121             n :: Int
 122             n = round $ 100 * a' / t
 123             a'= fromIntegral $ length a
 124             t :: Double
 125             t = fromIntegral $ length $ List.concat $ elems m
 126
 127 --------------------------------------------------------------
 128 -- Utils
 129 {--
 130 map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
 131 map2intMap m = IntMap.fromListWith (<>)
 132              $ map (\((k1,k2), v) -> if k1 < k2
 133                                    then (k1, IntMap.singleton k2 v)
 134                                    else (k2, IntMap.singleton k1 v)
 135                     )
 136              $ Map.toList m
 137
 138 look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
 139 look (k1,k2) m = if k1 < k2
 140                     then case (IntMap.lookup k1 m) of
 141                            Just m' -> IntMap.lookup k2 m'
 142                            _       -> Nothing
 143                     else look (k2,k1) m
 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
 153 median :: (Ord a, Fractional a) => [a] -> a
 154 median [] = panic "medianFast: empty list has no median"
 155 median zs =
 156    let recurse (x0:_)    (_:[])   = x0
 157        recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
 158        recurse (_:xs)    (_:_:ys) = recurse xs ys
 159        recurse _ _  =
 160           panic "median: this error cannot occur in the way 'recurse' is called"
 161    in  recurse zs zs
 162
 163 -}