[FEAT] bridgeness work

src/Gargantext/Prelude.hs

@@ -30,6 +30,7 @@ module Gargantext.Prelude
   , sortWith
   , module Prelude
   , MonadBase(..)
+  , Map2 , lookup2
   )
   where
 
@@ -37,6 +38,7 @@ import Control.Monad.Base (MonadBase(..))
 import GHC.Exts (sortWith)
 import GHC.Err.Located (undefined)
 import GHC.Real (round)
+import Data.Map (Map, lookup)
 import Data.Maybe (isJust, fromJust, maybe)
 import Data.Text (Text)
 import Protolude ( Bool(True, False), Int, Int64, Double, Integer
@@ -298,9 +300,25 @@ movingAverage steps xs = map mean $ chunkAlong steps 1 xs
 ma :: [Double] -> [Double]
 ma = movingAverage 3
 
-
 -----------------------------------------------------------------------
 fib :: Int -> Int
 fib 0 = 0
 fib 1 = 1
 fib n = fib (n-1) + fib (n-2)
+
+
+-----------------------------------------------------------------------
+--- Map in Map = Map2
+-- To avoid Map (a,a) b
+type Map2 a b = Map a (Map a b)
+
+lookup2 :: Ord a
+        => a
+        -> a
+        -> Map2 a b
+        -> Maybe b
+lookup2 a b m = do
+  m' <- lookup a m
+  lookup b m'
+
+

src/Gargantext/Viz/Graph/Bridgeness.hs

@@ -10,20 +10,26 @@ Portability : POSIX
 Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
 filters inter-communities links.
 
-TODO rewrite Bridgeness with "equivalence structurale" metrics
+TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
+
+TODO use Map LouvainNodeId (Map LouvainNodeId)
+
+
+
+
+
 -}
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Gargantext.Viz.Graph.Bridgeness (bridgeness)
   where
---import GHC.Base (Semigroup)
+
+import Data.Ord (Down(..))
 import Gargantext.Prelude
---import Data.Tuple.Extra (swap)
---import Gargantext.Viz.Graph
-import Data.Map (Map, fromListWith, lookup, fromList, delete, toList, mapKeys, mapWithKey, elems)
+import Data.Map (Map, fromListWith, lookup, fromList, toList, mapWithKey, elems)
 import qualified Data.Map as DM
-import Data.Maybe (fromJust)
+import Data.Maybe (catMaybes)
 import Data.List (concat, sortOn)
 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 
@@ -45,34 +51,36 @@ bridgeness b ns = DM.fromList
                 . 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 (<>)
+groupEdges m = fromListWith (<>)
+             . catMaybes
              . map (\((n1,n2), d)
-                     -> ((,) <$> lookup n1 m
-                             <*> lookup n2 m
-                        , [((n1,n2),d)]
-                        )
-                   )
+                     -> let 
+                          n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
+                          n1n2_d = Just [((n1,n2),d)]
+                        in (,) <$> n1n2_m <*> n1n2_d
+                    )
              . toList
 
+-- | TODO : sortOn Confluence
 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
+    filter' (c1,c2) a
+      | c1 == c2  = a
+      | otherwise = take n $ sortOn (Down . snd) a
+          where
+            n = round $ 100 * b * a' / t
+            a'= fromIntegral $ length a
+            t = fromIntegral $ length $ concat $ elems m
 
 

src/Gargantext/Viz/Graph/Tools.hs

@@ -15,6 +15,7 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Tools
   where
 
+import Debug.Trace (trace)
 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
@@ -71,14 +72,14 @@ cooc2graph threshold myCooc = do
 
 
   partitions <- if (Map.size distanceMap > 0)
-      --then iLouvainMap 100 10 distanceMap
+      -- then iLouvainMap 100 10 distanceMap
       -- then hLouvain distanceMap
       then cLouvain level distanceMap
       else panic "Text.Flow: DistanceMap is empty"
 
   let
-    bridgeness' = distanceMap
-    _bridgeness' = bridgeness rivers partitions distanceMap
+    -- bridgeness' = distanceMap
+    bridgeness' = trace ("Rivers: " <> show rivers) $ bridgeness rivers partitions distanceMap
     confluence' = confluence (Map.keys bridgeness') 3 True False
 
   pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions