[FEAT] User can chose bridgeness method

src/Gargantext/API/Node/Update.hs

@@ -31,7 +31,7 @@ import Gargantext.Core.Methods.Similarities (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Viz.Graph (Strength)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
+import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
 import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
 import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
@@ -63,6 +63,7 @@ data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
 
                       | UpdateNodeParamsGraph { methodGraphMetric        :: !GraphMetric
                                               , methodGraphClustering    :: !PartitionMethod
+                                              , methodGraphBridgeness    :: !BridgenessMethod
                                               , methodGraphEdgesStrength :: !Strength
                                               , methodGraphNodeType1     :: !NgramsType
                                               , methodGraphNodeType2     :: !NgramsType
@@ -106,16 +107,16 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
     -> UpdateNodeParams
     -> (JobLog -> m ())
     -> m JobLog
-updateNode uId nId (UpdateNodeParamsGraph metric method strength nt1 nt2) logStatus = do
+updateNode uId nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) logStatus = do
 
   logStatus JobLog { _scst_succeeded = Just 1
                    , _scst_failed    = Just 0
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  printDebug "Computing graph: " method
-  _ <- recomputeGraph uId nId method (Just metric) (Just strength) nt1 nt2 True
-  printDebug "Graph computed: " method
+  -- printDebug "Computing graph: " method
+  _ <- recomputeGraph uId nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
+  -- printDebug "Graph computed: " method
 
   pure  JobLog { _scst_succeeded = Just 2
                , _scst_failed    = Just 0
@@ -275,7 +276,7 @@ instance ToSchema  UpdateNodeParams
 instance Arbitrary UpdateNodeParams where
   arbitrary = do
     l <- UpdateNodeParamsList  <$> arbitrary
-    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
     t <- UpdateNodeParamsTexts <$> arbitrary
     b <- UpdateNodeParamsBoard <$> arbitrary
     elements [l,g,t,b]

src/Gargantext/Core/NodeStory.hs

@@ -455,7 +455,7 @@ insertArchiveList c nodeId a = do
   where
     query :: PGS.Query
     query = [sql| INSERT INTO node_stories(node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
-                    SELECT ?, ?, ?, ngrams.id, ? FROM ngrams WHERE terms = ? |]
+                    SELECT * WHERE EXISTS (SELECT ?, ?, ?, ngrams.id, ? FROM ngrams WHERE terms = ?) |]
 
 deleteArchiveList :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
 deleteArchiveList c nodeId a = do

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

@@ -107,7 +107,8 @@ getGraph _uId nId = do
         let defaultMetric          = Order1
         let defaultPartitionMethod = Spinglass
         let defaultEdgesStrength   = Strong
-        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
+        let defaultBridgenessMethod = BridgenessMethod_Basic
+        graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
         mt     <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
         let
           graph'' = set graph_metadata (Just mt) graph'
@@ -125,13 +126,14 @@ recomputeGraph :: FlowCmdM env err m
                => UserId
                -> NodeId
                -> PartitionMethod
+               -> BridgenessMethod
                -> Maybe GraphMetric
                -> Maybe Strength
                -> NgramsType
                -> NgramsType
                -> Bool
                -> m Graph
-recomputeGraph _uId nId method maybeSimilarity maybeStrength nt1 nt2 force = do
+recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -159,7 +161,7 @@ recomputeGraph _uId nId method maybeSimilarity maybeStrength nt1 nt2 force = do
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
-        !g <- computeGraph cId method similarity strength (nt1,nt2) repo
+        !g <- computeGraph cId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo
         let g' = set graph_metadata mt g
         _nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
         pure g'
@@ -180,12 +182,13 @@ recomputeGraph _uId nId method maybeSimilarity maybeStrength nt1 nt2 force = do
 computeGraph :: FlowCmdM env err m
              => CorpusId
              -> PartitionMethod
+             -> BridgenessMethod
              -> Similarity
              -> Strength
              -> (NgramsType, NgramsType)
              -> NodeListStory
              -> m Graph
-computeGraph corpusId method similarity strength (nt1,nt2) repo = do
+computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
   -- Getting the Node parameters
   lId  <- defaultList corpusId
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -214,7 +217,7 @@ computeGraph corpusId method similarity strength (nt1,nt2) repo = do
 
   -- TODO MultiPartite Here
   graph <- liftBase
-        $ cooc2graphWith method (MultiPartite (Partite (HashMap.keysSet m1) nt1)
+        $ cooc2graphWith partitionMethod bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
                                               (Partite (HashMap.keysSet m2) nt2)
                                               )
                                 similarity 0 strength myCooc
@@ -276,7 +279,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- recomputeGraph u n Spinglass Nothing Nothing NgramsTerms NgramsTerms False
+  _g <- recomputeGraph u n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -331,7 +334,7 @@ recomputeVersions :: FlowCmdM env err m
                   => UserId
                   -> NodeId
                   -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing NgramsTerms NgramsTerms False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
 
 ------------------------------------------------------------
 graphClone :: UserId

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

@@ -7,10 +7,14 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
+Let be a graph Bridgeness filters inter-communities links in two ways.
+If the partitions are known, filtering is uniform to expose the communities clearly for the beginners.
+But 
+
+
+uniformly
 filters inter-communities links.
 
-TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
 TODO use Map LouvainNodeId (Map LouvainNodeId)
 -}
 
@@ -20,44 +24,46 @@ module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
   where
 
 import Gargantext.Core.Methods.Similarities (Similarity(..))
-import Data.IntMap (IntMap)
+-- import Data.IntMap (IntMap)
 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
 import Data.Maybe (catMaybes)
 import Data.Ord (Down(..))
 import Debug.Trace (trace)
 import Gargantext.Prelude
 import Graph.Types (ClusterNode(..))
-import qualified Data.IntMap as IntMap
+-- import qualified Data.IntMap as IntMap
 import qualified Data.List   as List
 import qualified Data.Map    as Map
 import qualified Data.Set    as Set
 
 ----------------------------------------------------------------------
-type Partitions a = Map (Int, Int) Double -> IO [a]
+
+type Partitions = Map (Int, Int) Double -> IO [ClusterNode]
 ----------------------------------------------------------------------
-class ToComId a where
-  nodeId2comId :: a -> (NodeId,CommunityId)
+nodeId2comId :: ClusterNode -> (NodeId, CommunityId)
+nodeId2comId (ClusterNode i1 i2) = (i1, i2)
 
 type NodeId        = Int
 type CommunityId   = Int
 
-----------------------------------------------------------------------
-instance ToComId ClusterNode where
-  nodeId2comId (ClusterNode i1 i2) = (i1, i2)
-
 ----------------------------------------------------------------------
 ----------------------------------------------------------------------
-type Bridgeness = Double
+data Bridgeness = Bridgeness_Basic { bridgeness_partitions :: [ClusterNode]
+                                   , bridgeness_filter     :: Double
+                                   }
+                | Bridgeness_Advanced { bridgeness_similarity :: Similarity
+                                      , bridgness_confluence  :: Confluence
+                                      }
+
 type Confluence = Map (NodeId, NodeId) Double
 
 
-bridgeness3 :: Similarity
-           -> Confluence
+bridgeness :: Bridgeness
             -> Map (NodeId, NodeId) Double
             -> Map (NodeId, NodeId) Double
-bridgeness3 sim c m = Map.fromList
+bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
                 $ map (\(ks, (v1,_v2)) -> (ks,v1))
-                $ List.take (if sim == Conditional then 2*n else 4*n)
+                $ List.take (if sim == Conditional then 2*n else 3*n)
                 $ List.sortOn (Down . (snd . snd))
                 $ Map.toList
                 $ trace ("bridgeness3 m c" <> show (m,c)) $ Map.intersectionWithKey (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2))) (v1, v2)) m c
@@ -73,41 +79,11 @@ bridgeness3 sim c m = Map.fromList
       where
         (as, bs) = List.unzip $ Map.keys m
 
-
-map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
-map2intMap m = IntMap.fromListWith (<>)
-             $ map (\((k1,k2), v) -> if k1 < k2
-                                   then (k1, IntMap.singleton k2 v)
-                                   else (k2, IntMap.singleton k1 v)
-                    )
-             $ Map.toList m
-
-look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
-look (k1,k2) m = if k1 < k2
-                    then case (IntMap.lookup k1 m) of
-                           Just m' -> IntMap.lookup k2 m'
-                           _       -> Nothing
-                    else look (k2,k1) m
-
-
-bridgeness :: ToComId a
-           => Confluence
-           -> [a]
-           -> Map (NodeId, NodeId) Double
-           -> Map (NodeId, NodeId) Double
-bridgeness = bridgenessWith nodeId2comId
-  where
-    bridgenessWith :: (a -> (Int, Int))
-               -> Confluence
-               -> [a]
-               -> Map (Int, Int) Double
-               -> Map (Int, Int) Double
-    bridgenessWith f b ns = Map.fromList
-                           . List.concat
-                           . Map.elems
-                           . filterComs b
-                           . groupEdges (Map.fromList $ map f ns)
-
+bridgeness (Bridgeness_Basic ns b) m = Map.fromList
+                                     $ List.concat
+                                     $ Map.elems
+                                     $ filterComs b
+                                     $ groupEdges (Map.fromList $ map nodeId2comId ns) m
 
 groupEdges :: (Ord a, Ord b1)
            => Map b1 a
@@ -142,13 +118,31 @@ filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
             t = fromIntegral $ length $ List.concat $ elems m
 
 --------------------------------------------------------------
-
+-- Utils
 {--
+map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
+map2intMap m = IntMap.fromListWith (<>)
+             $ map (\((k1,k2), v) -> if k1 < k2
+                                   then (k1, IntMap.singleton k2 v)
+                                   else (k2, IntMap.singleton k1 v)
+                    )
+             $ Map.toList m
+
+look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
+look (k1,k2) m = if k1 < k2
+                    then case (IntMap.lookup k1 m) of
+                           Just m' -> IntMap.lookup k2 m'
+                           _       -> Nothing
+                    else look (k2,k1) m
+
+
+{-
 Compute the median of a list
 From:  https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
 Compute the center of the list in a more lazy manner
 and thus halves memory requirement.
 -}
+
 median :: (Ord a, Fractional a) => [a] -> a
 median [] = panic "medianFast: empty list has no median"
 median zs =
@@ -159,3 +153,4 @@ median zs =
           panic "median: this error cannot occur in the way 'recurse' is called"
    in  recurse zs zs
 
+-}

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

@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
 import Gargantext.Core.Methods.Similarities.Conditional (conditional)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness3, Partitions, ToComId(..))
+import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
 import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
 import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
@@ -57,6 +57,14 @@ 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]
@@ -89,6 +97,7 @@ cooc2graph' distance threshold myCooc
 
 -- coocurrences graph computation
 cooc2graphWith :: PartitionMethod
+               -> BridgenessMethod
                -> MultiPartite
                -> Similarity
                -> Threshold
@@ -102,15 +111,15 @@ cooc2graphWith Infomap   = cooc2graphWith' (infomap "-v -N2")
                         -- TODO: change these options, or make them configurable in UI?
 
 
-cooc2graphWith' :: ToComId a
-               => Partitions a
+cooc2graphWith' :: Partitions
+                -> BridgenessMethod
                 -> MultiPartite
                 -> Similarity
                 -> Threshold
                 -> Strength
                 -> HashMap (NgramsTerm, NgramsTerm) Int
                 -> IO Graph
-cooc2graphWith' doPartitions 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` return ()
 
@@ -130,7 +139,9 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
 
   let
     !confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
-    !bridgeness' = bridgeness3 similarity confluence' distanceMap
+    !bridgeness' = if bridgenessMethod == BridgenessMethod_Basic
+                      then bridgeness (Bridgeness_Basic partitions 1.0) distanceMap
+                      else bridgeness (Bridgeness_Advanced similarity confluence') distanceMap
 
   pure $ data2graph multi ti diag bridgeness' confluence' partitions
 
@@ -195,13 +206,12 @@ nodeTypeWith (MultiPartite (Partite s1 t1) (Partite _s2 t2)) t =
      else t2
 
 
-data2graph :: ToComId a
-           => MultiPartite
+data2graph :: MultiPartite
            -> Map NgramsTerm Int
            -> Map (Int, Int) Occurrences
            -> Map (Int, Int) Double
            -> Map (Int, Int) Double
-           -> [a]
+           -> [ClusterNode]
            -> Graph
 data2graph multi labels' occurences bridge conf partitions =
   Graph { _graph_nodes = nodes