[FEAT] Clustering Method Confluence backend connection

package.yaml

@@ -163,7 +163,7 @@ library:
   - full-text-search
   - fullstop
   - gargantext-prelude
-    #  - gargantext-graph >= 0.1.0.0
+  - gargantext-graph >= 0.1.0.0
   - graphviz
   - hashable
   - haskell-igraph

src/Gargantext/API/Node/Update.hs

@@ -23,29 +23,30 @@ import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
-import qualified Gargantext.API.Metrics as Metrics
 import Gargantext.API.Ngrams.List (reIndexWith)
-import qualified Gargantext.API.Ngrams.Types as NgramsTypes
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Methods.Distances (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
+import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
 import Gargantext.Database.Action.Flow.Pairing (pairing)
-import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node (getNode)
-import Gargantext.Database.Schema.Node (node_parent_id)
 import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
-import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic)
-import qualified Gargantext.Utils.Aeson as GUA
+import Gargantext.Database.Schema.Node (node_parent_id)
+import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic, (<*>))
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import qualified Data.Set as Set
+import qualified Data.Set                    as Set
+import qualified Gargantext.API.Metrics      as Metrics
+import qualified Gargantext.API.Ngrams.Types as NgramsTypes
+import qualified Gargantext.Utils.Aeson      as GUA
 
 ------------------------------------------------------------------------
 type API = Summary " Update node according to NodeType params"
@@ -53,7 +54,9 @@ type API = Summary " Update node according to NodeType params"
 
 ------------------------------------------------------------------------
 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
-                      | UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
+                      | UpdateNodeParamsGraph { methodGraphMetric     :: !GraphMetric 
+                                              , methodGraphClustering :: !PartitionMethod
+                                              }
                       | UpdateNodeParamsTexts { methodTexts :: !Granularity }
                       | UpdateNodeParamsBoard { methodBoard :: !Charts      }
                       | LinkNodeReq { nodeType :: !NodeType, id :: !NodeId }
@@ -89,7 +92,7 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
     -> UpdateNodeParams
     -> (JobLog -> m ())
     -> m JobLog
-updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
+updateNode uId nId (UpdateNodeParamsGraph metric method) logStatus = do
 
   logStatus JobLog { _scst_succeeded = Just 1
                    , _scst_failed    = Just 0
@@ -97,7 +100,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
                    , _scst_events    = Just []
                    }
 
-  _ <- recomputeGraph uId nId (Just metric) True
+  _ <- recomputeGraph uId nId method (Just metric) True
 
   pure  JobLog { _scst_succeeded = Just 2
                , _scst_failed    = Just 0
@@ -228,7 +231,7 @@ instance ToSchema  UpdateNodeParams
 instance Arbitrary UpdateNodeParams where
   arbitrary = do
     l <- UpdateNodeParamsList  <$> arbitrary
-    g <- UpdateNodeParamsGraph <$> arbitrary
+    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary
     t <- UpdateNodeParamsTexts <$> arbitrary
     b <- UpdateNodeParamsBoard <$> arbitrary
     elements [l,g,t,b]

src/Gargantext/Core/Methods/Distances.hs

@@ -53,5 +53,3 @@ instance Arbitrary GraphMetric where
 
 ------------------------------------------------------------------------
 
-
-

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

@@ -90,7 +90,7 @@ getGraph _uId nId = do
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
     camera = nodeGraph ^. node_hyperdata . hyperdataCamera
-    
+
   mcId <- getClosestParentIdByType nId NodeCorpus
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
@@ -102,7 +102,7 @@ getGraph _uId nId = do
   case graph of
     Nothing     -> do
         let defaultMetric = Order1
-        graph' <- computeGraph cId (withMetric defaultMetric) NgramsTerms repo
+        graph' <- computeGraph cId Spinglass (withMetric defaultMetric) NgramsTerms repo
         mt     <- defaultGraphMetadata cId "Title" repo defaultMetric
         let
           graph'' = set graph_metadata (Just mt) graph'
@@ -119,10 +119,11 @@ getGraph _uId nId = do
 recomputeGraph :: FlowCmdM env err m
                => UserId
                -> NodeId
+               -> PartitionMethod
                -> Maybe GraphMetric
                -> Bool
                -> m Graph
-recomputeGraph _uId nId maybeDistance force = do
+recomputeGraph _uId nId method maybeDistance force = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -144,7 +145,7 @@ recomputeGraph _uId nId maybeDistance force = do
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
-        g <- computeGraph cId similarity NgramsTerms repo
+        g <- computeGraph cId method similarity NgramsTerms repo
         let g' = set graph_metadata mt g
         _ <- updateHyperdata nId (HyperdataGraph (Just g') camera)
         pure g'
@@ -163,11 +164,12 @@ recomputeGraph _uId nId maybeDistance force = do
 
 computeGraph :: FlowCmdM env err m
              => CorpusId
+             -> PartitionMethod
              -> Distance
              -> NgramsType
              -> NodeListStory
              -> m Graph
-computeGraph cId d nt repo = do
+computeGraph cId method d nt repo = do
   lId  <- defaultList cId
   lIds <- selectNodesWithUsername NodeList userMaster
 
@@ -186,8 +188,9 @@ computeGraph cId d nt repo = do
 
   listNgrams <- getListNgrams [lId] nt
 
-  -- graph <- liftBase $ cooc2graphWith Bac d 0 myCooc
-  graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
+  -- graph <- liftBase $ cooc2graphWith Confluence d 0 myCooc
+  -- graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
+  graph <- liftBase $ cooc2graphWith method d 0 myCooc
   -- saveAsFileDebug "debug/graph" graph
 
   pure $ mergeGraphNgrams graph (Just listNgrams)
@@ -244,7 +247,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- trace (show u) $ recomputeGraph u n Nothing False
+  _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing False
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -299,7 +302,7 @@ recomputeVersions :: FlowCmdM env err m
                   => UserId
                   -> NodeId
                   -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Nothing False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing False
 
 ------------------------------------------------------------
 graphClone :: UserId

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

@@ -23,8 +23,8 @@ import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
 import Data.Maybe (catMaybes)
 import Data.Ord (Down(..))
 import Gargantext.Prelude
+import Graph.Types (ClusterNode(..))
 import qualified Data.Map as DM
-import Gargantext.Core.Viz.Graph.Types (ClusterNode(..))
 
 
 

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

@@ -14,10 +14,13 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph.Tools
   where
 
+import Data.Aeson
 import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
+import Data.Swagger hiding (items)
 import GHC.Float (sin, cos)
+import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Methods.Distances (Distance(..), measure)
 import Gargantext.Core.Methods.Distances.Conditional (conditional)
@@ -27,19 +30,31 @@ import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
 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.Types (ClusterNode)
 import Gargantext.Core.Viz.Graph.Utils (edgesFilter)
 import Gargantext.Prelude
+import Graph.Types (ClusterNode)
 import IGraph.Random -- (Gen(..))
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
 import qualified Data.HashMap.Strict      as HashMap
 import qualified Data.List                as List
 import qualified Data.Map                 as Map
 import qualified Data.Set                 as Set
 import qualified Data.Vector.Storable     as Vec
+import qualified Graph.BAC.ProxemyOptim   as BAC
 import qualified IGraph                   as Igraph
 import qualified IGraph.Algorithms.Layout as Layout
 
 
+data PartitionMethod = Spinglass | Confluence
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+instance FromJSON  PartitionMethod
+instance ToJSON    PartitionMethod
+instance ToSchema  PartitionMethod
+instance Arbitrary PartitionMethod where
+  arbitrary = elements [ minBound .. maxBound ]
+
+
 -------------------------------------------------------------
 defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
 -- defaultClustering x = pure $ BAC.defaultClustering x
@@ -68,8 +83,6 @@ cooc2graph' distance threshold myCooc
         myCooc' = toIndex ti myCooc
 
 
-data PartitionMethod = Louvain | Spinglass
--- TODO Bac
 
 -- coocurrences graph computation
 cooc2graphWith :: PartitionMethod
@@ -77,9 +90,8 @@ cooc2graphWith :: PartitionMethod
                -> Threshold
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith Louvain   = undefined
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
--- cooc2graphWith Bac       = cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
+cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
 
 
 cooc2graphWith' :: ToComId a
@@ -275,7 +287,7 @@ getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") ident
         ns = map snd items
 
     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
-    toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
+    toVec n' ns' m'' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m'') ns')
 ------------------------------------------------------------------------
 
 -- | KamadaKawai Layout

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

@@ -17,18 +17,17 @@ module Gargantext.Core.Viz.Graph.Tools.IGraph
 
 import Data.Serialize
 import Data.Singletons (SingI)
+import Gargantext.Core.Viz.Graph.Index
+import Graph.Types (ClusterNode(..))
 import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
 import Protolude
-import Gargantext.Core.Viz.Graph.Index
--- import Graph.Types
-import Gargantext.Core.Viz.Graph.Types
 import qualified Data.List                   as List
+import qualified Data.Map                    as Map
 import qualified IGraph                      as IG
 import qualified IGraph.Algorithms.Clique    as IG
 import qualified IGraph.Algorithms.Community as IG
 import qualified IGraph.Algorithms.Structure as IG
 import qualified IGraph.Random               as IG
-import qualified Data.Map                    as Map
 
 ------------------------------------------------------------------
 -- | Main Types

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

@@ -31,10 +31,3 @@ type Graph a b = DGIP.Gr a b
 -- type MatrixD          n = Dense.L n n
 -- type MatrixS          n = Sparse.Matrix n n Double
 
-
-data ClusterNode = ClusterNode
-  { cl_node_id      :: Int
-  , cl_community_id :: Int
-  } deriving Show
-
-

stack.yaml

@@ -31,8 +31,8 @@ allow-newer: true
 extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
   commit: 220f32810f988a5a121f110a7d557fc7d0721712
-#- git: ssh://gitolite3@delanoe.org/gargantext-graph
-#  commit: 294887a220460bd0c114638fff9ea53306cd2f18
+- git: https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
+  commit: f68f9e78ff4302f53d0855190574c2d818a00b4d
   # Data Mining Libs
 - git: https://github.com/delanoe/data-time-segment.git
   commit: 10a416b9f6c443866b36479c3441ebb3bcdeb7ef