diff --git a/src/Gargantext/Viz/Graph/Tools.hs b/src/Gargantext/Viz/Graph/Tools.hs index a97a9c62d0f7c700286ad4bcebf4b1358c05c863..71dd2a4006f3982b7f4b87b5ea3518e3868b8859 100644 --- a/src/Gargantext/Viz/Graph/Tools.hs +++ b/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)] diff --git a/src/Gargantext/Viz/Phylo/Cluster.hs b/src/Gargantext/Viz/Phylo/Cluster.hs index 77145c7afe875ca114e798926c049bce71b77409..90931805a2c30e1573b7279e0a3b7a659bec951b 100644 --- a/src/Gargantext/Viz/Phylo/Cluster.hs +++ b/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 diff --git a/stack.yaml b/stack.yaml index e1d3ba3c8ee8a3341aa34e668291549d57d68472..436b5fd605a56c8d8341c9de23923773e2e774b8 100644 --- a/stack.yaml +++ b/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