Add alternative bridgeness method

In the process, did some restructuring of the `bridgeness` function
and removed the `Bridgeness` type, whose purpose was not clear.
Removed a bit of dead code in the process.

src/Gargantext/API/Node/Update/Types.hs

@@ -5,8 +5,8 @@ import Data.Aeson
 import Data.Swagger ( ToSchema )
 import Gargantext.Core.Methods.Similarities (GraphMetric(..))
 import Gargantext.Core.Text.Ngrams (NgramsType)
-import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
-import Gargantext.Core.Viz.Graph.Types (Strength)
+import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
+import Gargantext.Core.Viz.Graph.Types (BridgenessMethod, Strength)
 import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
 import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
 import Gargantext.Prelude

src/Gargantext/Core/Viz/Graph/API.hs

@@ -73,7 +73,7 @@ getGraph nId = do
         let defaultMetric          = Order1
         let defaultPartitionMethod = Spinglass
         let defaultEdgesStrength   = Strong
-        let defaultBridgenessMethod = BridgenessMethod_Basic
+        let defaultBridgenessMethod = BridgenessBasic
         graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
         mt     <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength
         let mt' = set gm_legend (generateLegend graph') mt
@@ -239,7 +239,7 @@ graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
                -> m ()
 graphRecompute n jobHandle = do
   markStarted 1 jobHandle
-  _g <- recomputeGraph n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
+  _g <- recomputeGraph n Spinglass BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
   markComplete jobHandle
 
 graphVersions :: (HasNodeStory env err m)
@@ -274,7 +274,7 @@ graphVersions u nId = do
 recomputeVersions :: HasNodeStory env err m
                   => NodeId
                   -> m Graph
-recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
+recomputeVersions nId = recomputeGraph nId Spinglass BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
 
 ------------------------------------------------------------
 graphClone :: (HasNodeError err)

src/Gargantext/Core/Viz/Graph/Bridgeness.hs

@@ -20,8 +20,6 @@ TODO use Map LouvainNodeId (Map LouvainNodeId)
 
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
-{-# LANGUAGE BangPatterns #-}
-
 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
   where
 
@@ -31,7 +29,7 @@ import Data.Map.Strict (fromListWith, lookup, toList, mapWithKey, elems)
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Tuple.Extra qualified as Tuple
-import Gargantext.Core.Methods.Similarities (Similarity(..))
+import Gargantext.Core.Viz.Graph.Types (BridgenessMethod(..))
 import Gargantext.Prelude hiding (toList)
 import Graph.Types (ClusterNode(..))
 ----------------------------------------------------------------------
@@ -66,51 +64,21 @@ clusterNodes2sets = Dico.elems
                   . Dico.fromListWith (<>)
                   . (map ((Tuple.second Set.singleton) . swap . nodeId2comId))
 
-----------------------------------------------------------------------
-data Bridgeness = Bridgeness_Basic { bridgeness_partitions :: [ClusterNode]
-                                   , bridgeness_filter     :: Double
-                                   }
-                | Bridgeness_Advanced { bridgeness_similarity :: Similarity
-                                      , bridgness_confluence  :: Confluence
-                                      }
-                | Bridgeness_Recursive { br_partitions :: [[Set NodeId]]
-                                       , br_filter     :: Double
-                                       , br_similarity :: Similarity
-                                       }
-
-
-type Confluence = Map (NodeId, NodeId) Double
-
--- Filter Links between the Clusters
--- Links: Map (NodeId, NodeId) Double
--- List of Clusters: [Set NodeId]
-bridgeness :: Bridgeness
-            -> Map (NodeId, NodeId) Double
-            -> Map (NodeId, NodeId) Double
-bridgeness (Bridgeness_Recursive sn f sim) m =
-  Map.unions $ [linksBetween] <> map (\s -> bridgeness (Bridgeness_Basic (setNodes2clusterNodes s) (if sim == Conditional then pi*f else f)) m') sn
-    where
-      (linksBetween, m') = Map.partitionWithKey (\(n1,n2) _v -> Map.lookup n1 mapNodeIdClusterId
-                                                             /= Map.lookup n2 mapNodeIdClusterId
-                                                ) $ bridgeness (Bridgeness_Basic clusters f) m
-      clusters = setNodes2clusterNodes (map Set.unions sn)
-      mapNodeIdClusterId = clusterNodes2map clusters
-
-
-bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
-                $ List.filter (\x -> if sim == Conditional then snd x > 0.2 else snd x > 0.02)
-                $ map (\(ks, (v1,_v2)) -> (ks,v1))
-                $ Map.toList
-                $ Map.intersectionWithKey
-                      (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2)) :: Text) (v1, v2)) m c
-
-
-bridgeness (Bridgeness_Basic ns b) m = Map.fromList
-                                     $ List.concat
-                                     $ Map.elems
-                                     $ filterComs (round b)
-                                     $ groupEdges (Map.fromList $ map nodeId2comId ns) m
-
+-- | Filter the edges of a graph based on the computed clustering
+bridgeness :: [ClusterNode]               -- ^ Clustering
+           -> BridgenessMethod            -- ^ basic/advanced flag
+           -> Double                      -- ^ Bridgeness threshold
+           -> Map (NodeId, NodeId) Double -- ^ Input graph
+           -> Map (NodeId, NodeId) Double -- ^ Output graph
+bridgeness partitions method filterThreshold graph =
+  Map.fromList $
+  List.concat  $
+  Map.elems    $
+  (case method of
+     BridgenessBasic    -> filterComs (round filterThreshold)
+     BridgenessAdvanced -> filterComsAdvanced
+  )            $
+  groupEdges (Map.fromList $ map nodeId2comId partitions) graph
 
 groupEdges :: (Ord comId, Ord nodeId)
            => Map nodeId comId
@@ -130,7 +98,7 @@ filterComs :: (Ord n1, Eq n2)
            => Int
            -> Map (n2, n2) [(a3, n1)]
            -> Map (n2, n2) [(a3, n1)]
-filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
+filterComs b m = Map.filter (not . null) $ mapWithKey filter' m
   where
     filter' (c1,c2) a
       | c1 == c2  = a
@@ -143,6 +111,18 @@ filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
             t :: Double
             t = fromIntegral $ length $ List.concat $ elems m
 
+-- Weak links are often due to noise in the data and decrease the readability of the graph. 
+-- This function prunes the links between the clusters when their weight is under a given 'threshold'.  
+filterComsAdvanced :: (Ord a1, Fractional a1, Eq a2)
+                   => Map (a2, a2) [(a3, a1)]
+                   -> Map (a2, a2) [(a3, a1)]
+filterComsAdvanced m = Map.filter (not . null) $ mapWithKey filter' m
+  where
+    threshold = 0.03 -- TODO make this threshold configurable
+    filter' (c1,c2) xs
+      | c1 == c2  = xs
+      | otherwise = List.filter (\(_nn,v) -> v >= threshold) xs
+
 --------------------------------------------------------------
 -- Utils
 {--

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -30,11 +30,11 @@ import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
 import Gargantext.Core.Statistics ( pcaReduceTo, Dimension(Dimension) )
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId, setNodes2clusterNodes)
+import Gargantext.Core.Viz.Graph.Bridgeness (Partitions, bridgeness, nodeId2comId, setNodes2clusterNodes)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
 import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass, spinglass')
 import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
-import Gargantext.Core.Viz.Graph.Types (Attributes(..), Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..), LegendField(..))
+import Gargantext.Core.Viz.Graph.Types (Attributes(..), BridgenessMethod, Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..), LegendField(..))
 import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
 import Gargantext.Prelude
 import Graph.BAC.ProxemyOptim qualified as BAC
@@ -53,14 +53,6 @@ instance ToSchema  PartitionMethod
 instance Arbitrary PartitionMethod where
   arbitrary = elements [ minBound .. maxBound ]
 
-data BridgenessMethod = BridgenessMethod_Basic | BridgenessMethod_Advanced
-    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
-instance FromJSON  BridgenessMethod
-instance ToJSON    BridgenessMethod
-instance ToSchema  BridgenessMethod
-instance Arbitrary BridgenessMethod where
-  arbitrary = elements [ minBound .. maxBound ]
-
 
 -------------------------------------------------------------
 defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
@@ -112,7 +104,7 @@ cooc2graphWith' :: Partitions
                 -> Strength
                 -> HashMap (NgramsTerm, NgramsTerm) Int
                 -> IO Graph
-cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold strength myCooc = do
+cooc2graphWith' _doPartitions bridgenessMethod multi similarity threshold strength myCooc = do
   let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
   distanceMap `seq` diag `seq` ti `seq` pure ()
 
@@ -130,9 +122,10 @@ cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold stren
 
   let
     !confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
-    !bridgeness' = bridgeness
-      (Bridgeness_Basic (partitionsToClusterNodes partitions) 1.0)
-      distanceMap
+    !bridgeness' = bridgeness (partitionsToClusterNodes partitions)
+                              bridgenessMethod
+                              1.0
+                              distanceMap
 
   pure $ data2graph multi ti diag bridgeness' confluence' (setNodes2clusterNodes partitions)
 

src/Gargantext/Core/Viz/Graph/Types.hs

@@ -40,6 +40,16 @@ instance ToJSON TypeNode
 instance FromJSON TypeNode
 instance ToSchema TypeNode
 
+
+data BridgenessMethod = BridgenessBasic | BridgenessAdvanced
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+instance FromJSON  BridgenessMethod
+instance ToJSON    BridgenessMethod
+instance ToSchema  BridgenessMethod
+instance Arbitrary BridgenessMethod where
+  arbitrary = elements [ minBound .. maxBound ]
+
+
 data Attributes = Attributes { clust_default :: Int }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "") ''Attributes)