Merge remote-tracking branch 'origin/445-cherrypicked' into dev

src/Gargantext/API/Node/Update.hs

@@ -63,12 +63,12 @@ updateNode :: (HasNodeStory env err m
            -> JobHandle m
            -> m ()
 updateNode nId (UpdateNodeParamsGraph
-                    (UpdateNodeConfigGraph metric partitionMethod bridgeMethod strength nt1 nt2)) jobHandle = do
+                    (UpdateNodeConfigGraph metric bridgeMethod strength nt1 nt2)) jobHandle = do
 
   markStarted 2 jobHandle
   markProgress 1 jobHandle
   -- printDebug "Computing graph: " method
-  _ <- recomputeGraph nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
+  _ <- recomputeGraph nId bridgeMethod (Just metric) (Just strength) nt1 nt2 True
   -- printDebug "Graph computed: " method
   markComplete jobHandle
 

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

@@ -5,8 +5,7 @@ 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.Types (BridgenessMethod, Strength)
 import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
 import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
 import Gargantext.Prelude
@@ -46,7 +45,6 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
 
 ------------------------------------------------------------------------
 data UpdateNodeConfigGraph = UpdateNodeConfigGraph { methodGraphMetric        :: !GraphMetric
-                                                   , methodGraphClustering    :: !PartitionMethod
                                                    , methodGraphBridgeness    :: !BridgenessMethod
                                                    , methodGraphEdgesStrength :: !Strength
                                                    , methodGraphNodeType1     :: !NgramsType

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

@@ -71,10 +71,9 @@ getGraph nId = do
   case graph of
     Nothing     -> do
         let defaultMetric          = Order1
-        let defaultPartitionMethod = Spinglass
         let defaultEdgesStrength   = Strong
-        let defaultBridgenessMethod = BridgenessMethod_Basic
-        graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
+        let defaultBridgenessMethod = BridgenessBasic
+        graph' <- computeGraph cId defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
         mt     <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength
         let mt' = set gm_legend (generateLegend graph') mt
         let
@@ -91,7 +90,6 @@ getGraph nId = do
 --recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
 recomputeGraph :: HasNodeStory env err m
                => NodeId
-               -> PartitionMethod
                -> BridgenessMethod
                -> Maybe GraphMetric
                -> Maybe Strength
@@ -99,7 +97,7 @@ recomputeGraph :: HasNodeStory env err m
                -> NgramsType
                -> Bool
                -> m Graph
-recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
+recomputeGraph nId bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -127,7 +125,7 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
-        !g <- computeGraph cId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo
+        !g <- computeGraph cId bridgeMethod similarity strength (nt1,nt2) repo
         let mt' = set gm_legend (generateLegend g) mt
         let g' = set graph_metadata (Just mt') g
         _nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
@@ -154,14 +152,13 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
 -- TODO remove repo
 computeGraph :: HasNodeError err
              => CorpusId
-             -> PartitionMethod
              -> BridgenessMethod
              -> Similarity
              -> Strength
              -> (NgramsType, NgramsType)
              -> NodeListStory
              -> DBCmd err Graph
-computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
+computeGraph corpusId bridgeMethod similarity strength (nt1,nt2) repo = do
   -- Getting the Node parameters
   lId  <- defaultList corpusId
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -190,7 +187,7 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
 
   -- TODO MultiPartite Here
   liftBase
-        $ cooc2graphWith partitionMethod bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
+        $ cooc2graphWith bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
                                               (Partite (HashMap.keysSet m2) nt2)
                                               )
                                 similarity 0 strength myCooc
@@ -239,7 +236,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 BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
   markComplete jobHandle
 
 graphVersions :: (HasNodeStory env err m)
@@ -274,7 +271,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 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,8 +29,8 @@ 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.Prelude hiding (toList)
+import Gargantext.Core.Viz.Graph.Types (BridgenessMethod(..))
+import Gargantext.Prelude hiding (toList, filter)
 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,40 +111,14 @@ filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
             t :: Double
             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 =
-   let recurse (x0:_)    (_:[])   = x0
-       recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
-       recurse (_:xs)    (_:_:ys) = recurse xs ys
-       recurse _ _  =
-          panic "median: this error cannot occur in the way 'recurse' is called"
-   in  recurse zs zs
-
--}
+-- 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

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

@@ -23,18 +23,16 @@ import Data.HashSet qualified as HashSet
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
-import Data.Swagger ( ToSchema )
 import Data.Text qualified as Text
 import Data.Vector.Storable qualified as Vec
 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 (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
@@ -42,24 +40,6 @@ import Graph.Types (ClusterNode(..))
 import IGraph qualified as Igraph
 import IGraph.Algorithms.Layout qualified as Layout
 import IGraph.Random ( Gen ) -- (Gen(..))
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
-
-data PartitionMethod = Spinglass | Confluence | Infomap
-    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
-instance FromJSON  PartitionMethod
-instance ToJSON    PartitionMethod
-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 ]
 
 
 -------------------------------------------------------------
@@ -90,33 +70,18 @@ cooc2graph' distance threshold myCooc
 
 
 -- coocurrences graph computation
-cooc2graphWith :: PartitionMethod
-               -> BridgenessMethod
+cooc2graphWith :: BridgenessMethod
                -> MultiPartite
                -> Similarity
                -> Threshold
                -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
-cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
-cooc2graphWith Infomap   = cooc2graphWith' (infomap "-v -N2")
---cooc2graphWith Infomap   = cooc2graphWith' (infomap "--silent --two-level -N2")
-                        -- TODO: change these options, or make them configurable in UI?
-
-cooc2graphWith' :: Partitions
-                -> BridgenessMethod
-                -> MultiPartite
-                -> Similarity
-                -> Threshold
-                -> Strength
-                -> HashMap (NgramsTerm, NgramsTerm) Int
-                -> IO Graph
-cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold strength myCooc = do
+cooc2graphWith bridgenessMethod multi similarity threshold strength myCooc = do
   let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
   distanceMap `seq` diag `seq` ti `seq` pure ()
 
-  partitions <- if (Map.size distanceMap > 0)
+  partitions <- if Map.size distanceMap > 0
       then spinglass' 1 distanceMap
       else panic $ Text.unwords [ "I can not compute the graph you request"
                                 , "because either the quantity of documents"
@@ -130,13 +95,13 @@ 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)
 
-
 -- | A converter from the partition type returned by `spinglass'`
 -- to the partition type required by `bridgeness`
 partitionsToClusterNodes :: [Set Int] -> [ClusterNode]
@@ -154,7 +119,6 @@ partitionsToClusterNodes setlist =
   -- Turn pairs into `ClusterNode`s
   fmap (\(clusterId, nodeId) -> ClusterNode nodeId clusterId)
 
-
 type Reverse = Bool
 
 doSimilarityMap :: Similarity

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)