Merge remote-tracking branch 'origin/418-dev-louvain-clustering-on-filtered-graph' into dev-merge

package.json

@@ -43,6 +43,7 @@
         "esbuild": "^0.15.7",
         "graphology": "^0.24.1",
         "graphology-layout-forceatlas2": "^0.9.2",
+        "graphology-operators": "^1.6.0",
         "graphql": "^15.6.1",
         "graphql-ws": "^5.5.0",
         "highlightjs": "^9.16.2",

src/Gargantext/Components/GraphExplorer/Resources.purs

@@ -7,11 +7,12 @@ module Gargantext.Components.GraphExplorer.Resources
 
 import Gargantext.Prelude
 
-import DOM.Simple (window)
-import DOM.Simple.Types (Element)
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.Nullable (Nullable)
+import Data.Tuple (Tuple(..))
+import DOM.Simple (window)
+import DOM.Simple.Types (Element)
 import Effect.Class.Console as ECC
 import Gargantext.Components.App.Store as AppStore
 import Gargantext.Components.GraphExplorer.Store as GraphStore
@@ -62,6 +63,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
     { showEdges
     , edgeConfluence
     , edgeWeight
+    , forceAtlasState
     , graph
     , graphStage
     , hyperdataGraph
@@ -74,6 +76,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
     showEdges'        <- R2.useLive' showEdges
     edgeConfluence'   <- R2.useLive' edgeConfluence
     edgeWeight'       <- R2.useLive' edgeWeight
+    forceAtlasState' <- R2.useLive' forceAtlasState
     graphStage'       <- R2.useLive' graphStage
     graph'            <- R2.useLive' graph
     startForceAtlas'  <- R2.useLive' startForceAtlas
@@ -85,17 +88,17 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
     -- Clean up
     R.useEffectOnce $ do
       pure $ do
-        here.log "[graphCpt (Cleanup)]"
+        here.log "[drawGraph (Cleanup)]"
         case R.readRef fa2Ref of
           Nothing -> pure unit
           Just fa2 -> do
             ForceAtlas2.stop fa2
             ForceAtlas2.kill fa2
-            here.log2 "[graphCpt (Cleanup)] forceAtlas stopped for" fa2
+            here.log2 "[drawGraph (Cleanup)] forceAtlas stopped for" fa2
             R.setRef fa2Ref Nothing
-        Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Cleanup)] no sigma" $ \sigma -> do
+        Sigmax.dependOnSigma (R.readRef sigmaRef) "[drawGraph (Cleanup)] no sigma" $ \sigma -> do
           Sigma.kill sigma
-          here.log "[graphCpt (Cleanup)] sigma killed"
+          here.log "[drawGraph (Cleanup)] sigma killed"
 
     -- Stage Init
     R.useEffect1' graphStage' $ case graphStage' of
@@ -113,11 +116,11 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
                 pure $ Left "elRef is empty"
               Just el -> Sigma.sigma el { settings: sigmaSettings theme }
             case eSigma of
-              Left err -> here.warn2 "[graphCpt] error creating sigma" err
+              Left err -> here.warn2 "[drawGraph] error creating sigma" err
               Right sig -> do
                 Sigmax.writeSigma rSigma $ Just sig
 
-                Sigmax.dependOnContainer elRef "[graphCpt (Ready)] container not found" $ \c -> do
+                Sigmax.dependOnContainer elRef "[drawGraph (Ready)] container not found" $ \c -> do
                   _ <- Sigma.addRenderer sig {
                       "type": "canvas"
                     , container: c
@@ -128,7 +131,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
                 --newGraph <- Graphology.graphFromSigmaxGraph graph'
                 --Sigmax.refreshData sig newGraph
 
-                Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
+                Sigmax.dependOnSigma (R.readRef sigmaRef) "[drawGraph (Ready)] no sigma" $ \sigma -> do
                   -- bind the click event only initially, when ref was empty
                   Sigmax.bindSelectedNodesClick sigma selectedNodeIds multiSelectEnabled
                   Sigmax.bindShiftWheel sigma mouseSelectorSize
@@ -187,23 +190,27 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
     --       they changed → one solution could be to list every effects subject
     --       to a graph transformation (eg. "showLouvain", "edgeConfluence",
     --       etc) // drawback: don't forget to modify the effect white-list
-    R.useEffect' case graphStage' of
-
-      GET.Ready -> do
-        let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph
-        let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph
-
-        Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
-          Sigmax.performDiff sigma transformedGraph
-          -- Sigmax.updateEdges sigma tEdgesMap
-          -- Sigmax.updateNodes sigma tNodesMap
-          let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges'
-          -- here.log2 "[graphCpt] edgesState" edgesState
-          Sigmax.setSigmaEdgesVisibility sigma { edgeConfluence: edgeConfluence'
-                                               , edgeWeight: edgeWeight'
-                                               , showEdges: showEdges' }
-
-      _ -> pure unit
+    R.useEffect' $ do
+      let updateGraph = do
+              let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph
+              let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph
+
+              Sigmax.dependOnSigma (R.readRef sigmaRef) "[drawGraph (Ready)] no sigma" $ \sigma -> do
+                Sigmax.performDiff sigma transformedGraph
+                -- Sigmax.updateEdges sigma tEdgesMap
+                -- Sigmax.updateNodes sigma tNodesMap
+                let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges'
+                -- here.log2 "[graphCpt] edgesState" edgesState
+                Sigmax.setSigmaEdgesVisibility sigma { edgeConfluence: edgeConfluence'
+                                                     , edgeWeight: edgeWeight'
+                                                     , showEdges: showEdges' }
+
+      case Tuple forceAtlasState' graphStage' of
+
+        Tuple SigmaxTypes.InitialRunning GET.Ready -> updateGraph
+        Tuple SigmaxTypes.Paused GET.Ready -> updateGraph
+
+        _ -> pure unit
 
 
     -- | Render

src/Gargantext/Components/GraphExplorer/Toolbar/Buttons.purs

@@ -180,7 +180,7 @@ type ForceAtlasProps =
 pauseForceAtlasButton :: R2.Leaf ForceAtlasProps
 pauseForceAtlasButton = R2.leaf pauseForceAtlasButtonCpt
 pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
-pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
+pauseForceAtlasButtonCpt = here.component "pauseForceAtlasButtonButton" cpt
   where
     cpt { state } _ = do
       -- States

src/Gargantext/Hooks/Sigmax.purs

 module Gargantext.Hooks.Sigmax
   where
 
-import DOM.Simple.Types (Element)
 import Data.Array as A
 import Data.Either (either)
 import Data.Foldable (sequence_, foldl)
@@ -14,6 +13,7 @@ import Data.Set as Set
 import Data.Traversable (traverse_)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import DOM.Simple.Types (Element)
 import Effect (Effect)
 import Effect.Class.Console (error)
 import Effect.Timer (TimeoutId, clearTimeout)
@@ -131,13 +131,17 @@ handleForceAtlas2Pause fa2Ref forceAtlasState mFAPauseRef settings = do
       isFARunning <- ForceAtlas.isRunning fa2
       case Tuple toggled isFARunning of
         Tuple ST.InitialRunning false -> do
-          ForceAtlas.restart fa2
+          -- console.log "[handleForceAtlas2Paue)] restarting FA (InitialRunning)"
+          ForceAtlas.start fa2
         Tuple ST.Running false -> do
-          ForceAtlas.restart fa2
+          -- console.log2 "[handleForceAtlas2Pause] restarting FA (Running)" fa2
+          Graphology.updateGraphOnlyVisible (ForceAtlas.graph fa2)
+          ForceAtlas.start fa2
           case R.readRef mFAPauseRef of
             Nothing -> pure unit
             Just timeoutId -> clearTimeout timeoutId
         Tuple ST.Paused true -> do
+          -- console.log "[handleForceAtlas2Pause] stopping FA (Paused)"
           ForceAtlas.stop fa2
         _ -> pure unit
 

src/Gargantext/Hooks/Sigmax/ForceAtlas2.js

@@ -7,6 +7,7 @@ import FA2Layout from 'graphology-layout-forceatlas2/worker';
 
 export function _init(graph, settings) {
   // let inferred = forceAtlas2.inferSettings(graph);
+  // console.log('[init] graph', graph, 'settings', settings);
   return new FA2Layout(graph, {
     settings,
     getEdgeWeight: 'weight'

src/Gargantext/Hooks/Sigmax/ForceAtlas2.purs

@@ -19,6 +19,9 @@ import Record as Record
 -- | Type representing the web worker.
 foreign import data FA2Layout :: Type
 
+graph :: FA2Layout -> Graphology.Graph
+graph s = s .. "graph" :: Graphology.Graph
+
 -- TODO inferSettings
 -- TODO init with settings
 foreign import _init :: forall settings. EffectFn2 Graphology.Graph settings FA2Layout

src/Gargantext/Hooks/Sigmax/Graphology.js

@@ -30,6 +30,13 @@ export function _mapNodes(g, fn) {
   });
 }
 
+export function _filterNodes(g, fn) {
+  return g.filterNodes(function(name, attrs) {
+    return fn({id: name, ...attrs});
+  })
+}
+
+
 export function _forEachEdge(g, fn) {
   return g.forEachEdge(function(name, attrs, source, target, sourceAttributes, targetAttributes, undirected) {
     return fn({id: name,
@@ -59,3 +66,9 @@ export function _mapEdges(g, fn) {
                ...attrs});
   });
 }
+
+export function _filterEdges(g, fn) {
+  return g.filterEdges(function(name, attrs) {
+    return fn({id: name, ...attrs});
+  })
+}

src/Gargantext/Hooks/Sigmax/Graphology.purs

@@ -11,7 +11,7 @@ import Data.Array as A
 import Data.Function.Uncurried (Fn2, runFn2)
 import Data.Sequence as Seq
 import Data.Set as Set
-import Data.Traversable (traverse)
+import Data.Traversable (traverse, traverse_)
 import Effect (Effect)
 import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4)
 import FFI.Simple ((..), (...), (.=))
@@ -22,15 +22,20 @@ import Record as Record
 foreign import data Graph :: Type
 
 foreign import _newGraph :: EffectFn1 Unit Graph
+
 foreign import _addNode :: EffectFn3 Graph String (Record Types.Node) String
 foreign import _updateNode :: EffectFn3 Graph String (Record Types.Node -> Record Types.Node) Unit
 foreign import _addEdge :: EffectFn4 Graph String String (Record Types.Edge) String
 foreign import _mergeNodeAttributes :: forall a. EffectFn3 Graph String a Unit
 --foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String
 foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a)
+foreign import _filterNodes :: Fn2 Graph (Record Types.Node -> Boolean) (Array Types.NodeId)
+
 foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit
 foreign import _updateEachEdgeAttributes :: EffectFn2 Graph (Record Types.Edge -> Record Types.Edge) Unit
 foreign import _mapEdges :: forall a. Fn2 Graph (Record Types.Edge -> a) (Array a)
+foreign import _filterEdges :: Fn2 Graph (Record Types.Edge -> Boolean) (Array Types.EdgeId)
+
 
 newGraph :: Unit -> Effect Graph
 newGraph = runEffectFn1 _newGraph
@@ -65,6 +70,8 @@ forEachNode :: Graph -> (Record Types.Node -> Effect Unit) -> Effect Unit
 forEachNode g fn = pure $ g ... "forEachNode" $ [\_ n -> fn n]
 mapNodes :: forall a. Graph -> (Record Types.Node -> a) -> Array a
 mapNodes = runFn2 _mapNodes
+filterNodes :: Graph -> (Record Types.Node -> Boolean) -> Array Types.NodeId
+filterNodes = runFn2 _filterNodes
 
 addEdge :: Graph -> Record Types.Edge -> Effect String
 addEdge g edge@{ source, target } = runEffectFn4 _addEdge g source target edge
@@ -80,6 +87,8 @@ mapEdges :: forall a. Graph -> (Record Types.Edge -> a) -> Array a
 mapEdges = runFn2 _mapEdges
 updateEachEdgeAttributes :: Graph -> (Record Types.Edge -> Record Types.Edge) -> Effect Unit
 updateEachEdgeAttributes = runEffectFn2 _updateEachEdgeAttributes
+filterEdges :: Graph -> (Record Types.Edge -> Boolean) -> Array Types.EdgeId
+filterEdges = runFn2 _filterEdges
 
 -- TODO Maybe our use of this function (`updateWithGraph`) in code is
 -- too much. We convert Types.Graph into Graphology.Graph and then
@@ -138,6 +147,14 @@ nodeIds :: Graph -> Types.NodeIds
 nodeIds = Set.fromFoldable <<< nodes_
 
 
+-- | Leave out only visible nodes/edges in a graph
+updateGraphOnlyVisible :: Graph -> Effect Unit
+updateGraphOnlyVisible g = do
+  let hiddenNodeIds = filterNodes g (_.hidden)
+  let hiddenEdgeIds = filterEdges g (_.hidden)
+  traverse_ (removeEdge g) hiddenEdgeIds
+  traverse_ (removeNode g) hiddenNodeIds
+
 -- | Read graph into a graphology instance.
 -- graphRead :: forall nodeExtra node edgeExtra edge.
 --              NodeProps nodeExtra node => EdgeProps edgeExtra edge =>

yarn.lock

@@ -5395,7 +5395,14 @@ graphology-layout-forceatlas2@^0.9.2:
   dependencies:
     graphology-utils "^2.1.0"
 
-graphology-utils@^2.1.0, graphology-utils@^2.5.0:
+graphology-operators@^1.6.0:
+  version "1.6.0"
+  resolved "https://registry.yarnpkg.com/graphology-operators/-/graphology-operators-1.6.0.tgz#daad1600219ad47a3005504f252f80d9b402ad09"
+  integrity sha512-yfnVNsFd6plBw7r6Td4luGlNoQn9MKI56EZ/NcFcRmvu/D1R8eWHjpipNUdBjl5MVV8iSW8e/XuY8YsjRDnLoA==
+  dependencies:
+    graphology-utils "^2.0.0"
+
+graphology-utils@^2.0.0, graphology-utils@^2.1.0, graphology-utils@^2.5.0:
   version "2.5.2"
   resolved "https://registry.yarnpkg.com/graphology-utils/-/graphology-utils-2.5.2.tgz#4d30d6e567d27c01f105e1494af816742e8d2440"
   integrity sha512-ckHg8MXrXJkOARk56ZaSCM1g1Wihe2d6iTmz1enGOz4W/l831MBCKSayeFQfowgF8wd+PQ4rlch/56Vs/VZLDQ==