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
  18 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
  19   where
  20
  21 import Data.List (concat, sortOn)
  22 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
  23 import Data.Maybe (catMaybes)
  24 import Data.Ord (Down(..))
  25 import Gargantext.Prelude
  26 import Graph.Types (ClusterNode(..))
  27 import qualified Data.Map as DM
  28
  29 ----------------------------------------------------------------------
  30 type Partitions a = Map (Int, Int) Double -> IO [a]
  31 ----------------------------------------------------------------------
  32 class ToComId a where
  33   nodeId2comId :: a -> (NodeId,CommunityId)
  34
  35 type NodeId        = Int
  36 type CommunityId   = Int
  37
  38 ----------------------------------------------------------------------
  39 instance ToComId ClusterNode where
  40   nodeId2comId (ClusterNode i1 i2) = (i1, i2)
  41
  42 ----------------------------------------------------------------------
  43 ----------------------------------------------------------------------
  44 type Bridgeness = Double
  45
  46 bridgeness :: ToComId a
  47            => Bridgeness
  48            -> [a]
  49            -> Map (NodeId, NodeId) Double
  50            -> Map (NodeId, NodeId) Double
  51 bridgeness = bridgenessWith nodeId2comId
  52   where
  53     bridgenessWith :: (a -> (Int, Int))
  54                -> Bridgeness
  55                -> [a]
  56                -> Map (Int, Int) Double
  57                -> Map (Int, Int) Double
  58     bridgenessWith f b ns = DM.fromList
  59                        . concat
  60                        . DM.elems
  61                        . filterComs b
  62                        . groupEdges (DM.fromList $ map f ns)
  63
  64
  65 groupEdges :: (Ord a, Ord b1)
  66            => Map b1 a
  67            -> Map (b1, b1) b2
  68            -> Map (a, a) [((b1, b1), b2)]
  69 groupEdges m = fromListWith (<>)
  70              . catMaybes
  71              . map (\((n1,n2), d)
  72                      -> let
  73                           n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
  74                           n1n2_d = Just [((n1,n2),d)]
  75                         in (,) <$> n1n2_m <*> n1n2_d
  76                     )
  77              . toList
  78
  79 -- | TODO : sortOn Confluence
  80 filterComs :: (Ord n1, Eq n2)
  81            => p
  82            -> Map (n2, n2) [(a3, n1)]
  83            -> Map (n2, n2) [(a3, n1)]
  84 filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
  85   where
  86     filter' (c1,c2) a
  87       | c1 == c2  = a
  88       -- TODO use n here
  89       | otherwise = take 1 $ sortOn (Down . snd) a
  90            where
  91             _n :: Int
  92             _n = round $ 100 * a' / t
  93             a'= fromIntegral $ length a
  94             t :: Double
  95             t = fromIntegral $ length $ concat $ elems m
  96
  97 --------------------------------------------------------------
  98
  99 {--
 100 Compute the median of a list
 101 From:  https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
 102 Compute the center of the list in a more lazy manner
 103 and thus halves memory requirement.
 104 -}
 105 median :: (Ord a, Fractional a) => [a] -> a
 106 median [] = panic "medianFast: empty list has no median"
 107 median zs =
 108    let recurse (x0:_)    (_:[])   = x0
 109        recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
 110        recurse (_:xs)    (_:_:ys) = recurse xs ys
 111        recurse _ _  =
 112           panic "median: this error cannot occur in the way 'recurse' is called"
 113    in  recurse zs zs
 114