[GRAPH] fix parameters of clustering (for tests).

src/Gargantext/Viz/Graph/Tools.hs

@@ -15,6 +15,7 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Tools
   where
 
+import Debug.Trace (trace)
 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map (Map)
@@ -47,16 +48,39 @@ cooc2graph threshold myCooc = do
       distanceMat = measureConditional matCooc
       distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 
+  let nodesApprox :: Int
+      nodesApprox = n'
+        where
+          (as, bs) = List.unzip $ Map.keys distanceMap
+          n' = Set.size $ Set.fromList $ as <> bs
+      ClustersParams rivers level = trace ("nodesApprox: " <> show nodesApprox) $ clustersParams nodesApprox
+
+
   partitions <- case Map.size distanceMap > 0 of
-    True  -> cLouvain distanceMap
+    True  -> trace ("level" <> show level) $ cLouvain level distanceMap
     False -> panic "Text.Flow: DistanceMap is empty"
 
-  let bridgeness' = bridgeness 300 partitions distanceMap
+  let bridgeness' = trace ("rivers: " <> show rivers) $ bridgeness rivers partitions distanceMap
   let confluence' = confluence (Map.keys bridgeness') 3 True False
 
   data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
 
 
+
+data ClustersParams = ClustersParams { bridgness :: Double
+                                     , louvain   :: Text
+                                     } deriving (Show)
+
+clustersParams :: Int -> ClustersParams
+clustersParams x = ClustersParams (fromIntegral x) y
+  where
+    y | x < 100  = "0.0001"
+      | x < 350  = "0.001"
+      | x < 500  = "0.01"
+      | x < 1000 = "0.1"
+      | otherwise = "1"
+
+
 ----------------------------------------------------------
 -- | From data to Graph
 data2graph :: [(Text, Int)]

src/Gargantext/Viz/Phylo/Cluster.hs

@@ -53,7 +53,7 @@ relatedComp graphs = foldl' (\mem groups ->
 louvain :: ([GroupNode],[GroupEdge]) -> IO [[PhyloGroup]]
 louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community)
                       <$> groupBy (\a b -> (l_community_id a) == (l_community_id b))
-                      <$> (cLouvain $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges)
+                      <$> (cLouvain "0.0001" $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges)
   where
     -------------------------------------- 
     idx :: PhyloGroup -> Int

stack.yaml

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