[Optims]

src/Gargantext/Prelude.hs

@@ -31,10 +31,11 @@ module Gargantext.Prelude
   )
   where
 
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Concurrent (newEmptyMVar, takeMVar, putMVar, forkIO)
 import GHC.Exts (sortWith)
 import GHC.Err.Located (undefined)
 import GHC.Real (round)
-import Control.Monad.IO.Class (MonadIO)
 import Data.Maybe (isJust, fromJust, maybe)
 import Data.Text (Text)
 import Protolude ( Bool(True, False), Int, Int64, Double, Integer
@@ -305,3 +306,22 @@ fib n = fib (n-1) + fib (n-2)
 
 
 
+-----------------------------------------------------------------------
+-- Memory Optimization
+
+inMVarIO :: MonadIO m => m b -> m b
+inMVarIO f = do
+  mVar <- liftIO newEmptyMVar
+  zVar <- f
+  _ <- liftIO $ forkIO $ putMVar mVar zVar
+  liftIO $ takeMVar mVar
+
+inMVar :: b -> IO b
+inMVar f = do
+  mVar <- newEmptyMVar
+  let zVar = f
+  _ <- liftIO $ forkIO $ putMVar mVar zVar
+  liftIO $ takeMVar mVar
+
+
+

src/Gargantext/Viz/Graph/API.hs

@@ -99,7 +99,7 @@ getGraph uId nId = do
   newGraph  <- liftIO newEmptyMVar
   g <- case graph of
     Nothing     -> do
-      graph' <- computeGraph cId NgramsTerms repo
+      graph' <- inMVarIO $ computeGraph cId NgramsTerms repo
       _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
       pure graph'
 
@@ -134,7 +134,7 @@ computeGraph cId nt repo = do
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
-  graph <- liftIO $ cooc2graph 0 myCooc
+  graph <- liftIO $ inMVarIO $ cooc2graph 0 myCooc
   let graph' = set graph_metadata (Just metadata) graph
   pure graph'
 

src/Gargantext/Viz/Graph/Bridgeness.hs

@@ -25,7 +25,7 @@ import Data.Map (Map, fromListWith, lookup, fromList, delete, toList, mapKeys, m
 import qualified Data.Map as DM
 import Data.Maybe (fromJust)
 import Data.List (concat, sortOn)
-import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 
 
 -- TODO mv in Louvain Lib

src/Gargantext/Viz/Graph/IGraph.hs

@@ -8,6 +8,9 @@ Portability : POSIX
 
 Main IGraph funs/types to ease portability with FGL.
 
+Reference:
+* Gábor Csárdi, Tamás Nepusz: The igraph software package for complex network research. InterJournal Complex Systems, 1695, 2006.
+
 -}
 
 {-# LANGUAGE NoImplicitPrelude #-}

src/Gargantext/Viz/Graph/Tools.hs

@@ -15,10 +15,8 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Tools
   where
 
-import Control.Monad.IO.Class (liftIO)
-import Control.Concurrent (newEmptyMVar, takeMVar, putMVar, forkIO)
 import Debug.Trace (trace)
-import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map (Map)
 import qualified Data.Set as Set
@@ -70,20 +68,21 @@ cooc2graph threshold myCooc = do
           n' = Set.size $ Set.fromList $ as <> bs
       ClustersParams rivers level = {-trace ("nodesApprox: " <> show nodesApprox) $-} clustersParams nodesApprox
 
-  partitionsV <- liftIO newEmptyMVar
-  partitions' <- case Map.size distanceMap > 0 of
+  partitions <- inMVarIO $ case Map.size distanceMap > 0 of
     True  -> trace ("level" <> show level) $ cLouvain level distanceMap
     False -> panic "Text.Flow: DistanceMap is empty"
 
-  _ <- liftIO $ forkIO $ putMVar partitionsV partitions'
-  partitions <- liftIO $ takeMVar partitionsV
-
-  let bridgeness' = {-trace ("rivers: " <> show rivers) $-}
+  bridgeness' <- trace "bridgeness" $ inMVar $ {-trace ("rivers: " <> show rivers) $-}
                     bridgeness rivers partitions distanceMap
 
-  let confluence' = confluence (Map.keys bridgeness') 3 True False
+  confluence' <- trace "confluence" $ inMVar $ confluence (Map.keys bridgeness') 3 True False
+
+  r <- trace "data2graph" $ inMVarIO $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
+
+  pure r
+
+
 
-  data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
 
 
 data ClustersParams = ClustersParams { bridgness :: Double

src/Gargantext/Viz/Phylo/Cluster.hs

@@ -19,6 +19,7 @@ module Gargantext.Viz.Phylo.Cluster
   where
 import Control.Parallel.Strategies
 import Data.Graph.Clustering.Louvain.CplusPlus
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 import Data.List        (null,concat,sort,intersect,(++), elemIndex, groupBy, nub, union, (\\), (!!))
 import Data.Map         (Map, fromList, mapKeys)
 import Data.Tuple       (fst)

stack.yaml

@@ -4,6 +4,7 @@ extra-package-dbs: []
 packages:
 - .
 #- 'deps/servant-job'
+#- 'deps/clustering-louvain'
 
 docker:
   enable: false
@@ -49,7 +50,7 @@ extra-deps:
 - git: https://github.com/np/servant-job.git
   commit: 4016c76398a56e1a352a45b3ee9d698dd0dd2597
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
-  commit: e5814cbfa71f43b0a453efb65f476240d7d51a53
+  commit: f8fd33e4e9639730d47cd02b223a0f8fbbbfe975
 - git: https://github.com/np/patches-map
   commit: 8c6f38c4844ead53e664cf9c82ba461715dbe445
 - git: https://github.com/delanoe/haskell-opaleye.git  #- opaleye-0.6.7002.0