[FIX] graph clustering.

src/Gargantext/Text/List.hs

@@ -17,7 +17,7 @@ module Gargantext.Text.List
   where
 
 import Data.Either (partitionEithers, Either(..))
-import Debug.Trace (trace)
+-- import Debug.Trace (trace)
 import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
@@ -161,7 +161,7 @@ toList stop l n = case stop n of
 
 toTermList :: Int -> Int -> (a -> Bool) -> [a] -> [(ListType, a)]
 toTermList _ _ _ [] = []
-toTermList a b stop ns =  trace ("computing toTermList") $
+toTermList a b stop ns =  -- trace ("computing toTermList") $
                       map (toList stop CandidateTerm) xs
                    <> map (toList stop GraphTerm)     ys
                    <> toTermList a b stop zs

src/Gargantext/Viz/Graph/API.hs

@@ -24,6 +24,7 @@ Portability : POSIX
 module Gargantext.Viz.Graph.API
   where
 
+import Debug.Trace (trace)
 import Control.Lens (set, (^.), _Just, (^?))
 import Control.Monad.IO.Class (liftIO)
 import Data.Maybe (Maybe(..))
@@ -77,7 +78,8 @@ getGraph uId nId = do
   let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
                   identity
                   $ nodeGraph ^. node_parentId
-  case graph of
+
+  g <- case graph of
     Nothing     -> do
       graph' <- computeGraph cId NgramsTerms v
       _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
@@ -89,6 +91,8 @@ getGraph uId nId = do
                        graph'' <- computeGraph cId NgramsTerms v
                        _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
                        pure graph''
+  pure $ trace ("salut" <> show g) $ g
+
 
 -- TODO use Database Monad only here ?
 computeGraph :: CorpusId -> NgramsType -> Int -> GargServer (Get '[JSON] Graph)

src/Gargantext/Viz/Graph/Tools.hs

@@ -74,8 +74,8 @@ data ClustersParams = ClustersParams { bridgness :: Double
 clustersParams :: Int -> ClustersParams
 clustersParams x = ClustersParams (fromIntegral x) y
   where
-    y | x < 100  = "0.0001"
-      | x < 350  = "0.001"
+    y | x < 100  = "0.01"
+      | x < 350  = "0.01"
       | x < 500  = "0.01"
       | x < 1000 = "0.1"
       | otherwise = "1"

stack.yaml

@@ -4,7 +4,6 @@ extra-package-dbs: []
 packages:
 - .
 
-
 docker:
   enable: false
   repo: 'fpco/stack-build:lts-14.6-garg'
@@ -40,7 +39,7 @@ extra-deps:
 - git: https://github.com/np/servant-job.git
   commit: 8557bfc9472a1b2be0b7bc632c23701ba5f44bf8
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
-  commit: b29040ce741629d61cc63e8ba97e75bf0944979e
+  commit: e5814cbfa71f43b0a453efb65f476240d7d51a53
 - git: https://github.com/np/patches-map
   commit: 8c6f38c4844ead53e664cf9c82ba461715dbe445
 - git: https://github.com/delanoe/haskell-opaleye.git  #- opaleye-0.6.7002.0