[FEAT] Adding bridgeness function to filter links between partitions of a graph.

src/Gargantext/Text/Flow.hs

@@ -18,41 +18,32 @@ From text to viz, all the flow of texts in Gargantext.
 module Gargantext.Text.Flow
   where
 
+--import qualified Data.Array.Accelerate as A
+--import qualified Data.Set as DS
 import Control.Monad.Reader
-import GHC.IO (FilePath)
-import qualified Data.Text as T
-import Data.Text.IO (readFile)
-
+import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map.Strict (Map)
 import Data.Maybe (catMaybes)
---import qualified Data.Set as DS
-import Data.Text (Text)
-
---import qualified Data.Array.Accelerate as A
 import qualified Data.Map.Strict as M
-----------------------------------------------
+import qualified Data.Text as T
+import Data.Text (Text)
+import Data.Text.IO (readFile)
 import Database.PostgreSQL.Simple (Connection)
-
+import GHC.IO (FilePath)
+import Gargantext.Core (Lang)
+import Gargantext.Core.Types (CorpusId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Types.Node
-
-import Gargantext.Core (Lang)
 import Gargantext.Prelude
-
-import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
-import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
-import Gargantext.Viz.Graph (Graph(..), data2graph)
-import Gargantext.Text.Metrics.Count (cooc)
-import Gargantext.Viz.Graph.Bridgeness (bridgeness)
-import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
-import Gargantext.Text.Terms (TermType, extractTerms)
 import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
-import Gargantext.Core.Types (CorpusId)
-
+import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
+import Gargantext.Text.Metrics.Count (cooc)
 import Gargantext.Text.Parsers.CSV
-
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
-
+import Gargantext.Text.Terms (TermType, extractTerms)
+import Gargantext.Viz.Graph (Graph(..), data2graph)
+import Gargantext.Viz.Graph.Bridgeness (bridgeness)
+import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
+import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
 {-
   ____                             _            _
  / ___| __ _ _ __ __ _  __ _ _ __ | |_ _____  _| |_
@@ -169,6 +160,6 @@ cooc2graph myCooc = do
 -- Building : -> Graph -> JSON
   --printDebug "partitions" $ DS.size $ DS.fromList $ map (l_community_id) partitions
   --printDebug "partitions" partitions
-  let distanceMap' = bridgeness 5 partitions distanceMap
+  let distanceMap' = bridgeness 300 partitions distanceMap
   pure $ data2graph (M.toList ti) myCooc4 distanceMap' partitions
 

src/Gargantext/Viz/Graph/Bridgeness.hs

 {-|
 Module      : Gargantext.Viz.Graph.Bridgeness
-Description : 
+Description : Bridgeness filter
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
+filters inter-communities links.
 
 -}
 
@@ -14,56 +16,62 @@ Portability : POSIX
 
 module Gargantext.Viz.Graph.Bridgeness (bridgeness)
   where
-
+--import GHC.Base (Semigroup)
 import Gargantext.Prelude
+--import Data.Tuple.Extra (swap)
 --import Gargantext.Viz.Graph
-import Data.Map (Map, fromListWith, lookup, fromList, keys)
-import Data.Maybe (catMaybes)
-import Data.List (sortOn, concat)
+import Data.Map (Map, fromListWith, lookup, fromList, delete, toList, mapKeys, mapWithKey, elems)
+import qualified Data.Map as DM
+import Data.Maybe (fromJust)
+import Data.List (concat, sortOn)
 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
 
-type Bridgeness = Double
 
 -- TODO mv in Louvain Lib
 type LouvainNodeId = Int
 type CommunityId   = Int
 
-partition2map :: [LouvainNode] -> Map CommunityId [LouvainNodeId]
-partition2map ns = fromListWith (<>) [ (cId, [nId]) | LouvainNode nId cId <- ns]
-
-ordEdgesBetween :: (Ord distance, Ord node)
-                => [node] -> [node]
-                -> Map (node, node) distance
-                -> [((node, node), distance)]
-ordEdgesBetween c1 c2 d = sortOn snd $ catMaybes
-              [ (,) <$> Just   (n1,n2)
-                    <*> lookup (n1,n2) d
-              | n1 <- c1
-              , n2 <- c2
-              , n1 < n2
-              ]
-
-filterEdgesBetween :: (RealFrac b, Ord node, Ord distance) =>
-     b -> [node] -> [node]
-     -> Map (node, node) distance
-     -> [((node, node), distance)]
-filterEdgesBetween b c1 c2 d = take n d'
-  where
-    n  = round $ b * i / (len c1 + len c2)
-    d' = ordEdgesBetween c1 c2 d
-    i  = fromIntegral $ length d'
-    len c = fromIntegral $ length (ordEdgesBetween c c d)
+type Bridgeness = Double
 
 
 bridgeness :: Bridgeness
            -> [LouvainNode]
            -> Map (LouvainNodeId, LouvainNodeId) Double
            -> Map (LouvainNodeId, LouvainNodeId) Double
-bridgeness b ns' ds = fromList . concat . map (\(c1,c2) -> filterEdgesBetween b c1 c2 ds) $ p
-  where
-    p  = catMaybes [ (,) <$> lookup k1 ns <*> lookup k2 ns | k1 <- ks, k2 <- ks, k1 < k2]
-    ns = partition2map ns'
-    ks = keys ns
+bridgeness b ns = DM.fromList
+                . concat
+                . DM.elems
+                . filterComs b
+                . groupEdges (nodeId2comId ns)
+
+nodeId2comId :: [LouvainNode] -> Map LouvainNodeId CommunityId
+nodeId2comId ns = fromList [ (nId,cId) | LouvainNode nId cId <- ns]
 
+groupEdges :: Map LouvainNodeId CommunityId
+           -> Map (LouvainNodeId, LouvainNodeId) Double
+           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+groupEdges m = mapKeys fromJust
+             . delete Nothing
+             . fromListWith (<>)
+             . map (\((n1,n2), d)
+                     -> ((,) <$> lookup n1 m
+                             <*> lookup n2 m
+                        , [((n1,n2),d)]
+                        )
+                   )
+             . toList
+
+filterComs :: Bridgeness
+           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+filterComs b m = mapWithKey filter' m
+  where
+    filter' (c1,c2) a = case c1 == c2 of
+      True  -> a
+      False -> take n $ sortOn snd a
+        where
+          n = round $ b * a' / t
+          a'= fromIntegral $ length a
+          t = fromIntegral $ length $ concat $ elems m