[Community] Query search contact with text query on documents
[gargantext.git] / src / Gargantext / Viz / Phylo / Cluster.hs
index 4a0b244ca4684e560d112a86cafe413223d60b4d..f68377f5ae6a67338cd92325b47f20ee616aa8d8 100644 (file)
@@ -10,16 +10,13 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 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)
@@ -54,7 +51,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
@@ -92,7 +89,7 @@ groupsToGraph nbDocs prox gs = case prox of
                                                         candidates' = candidates `using` parList rdeepseq
                                                     in  candidates' )
       Hamming (HammingParams _)             -> (gs, map (\(x,y) -> ((x,y), hamming (getGroupCooc x) (getGroupCooc y))) $ getCandidates gs)
-      _                                     -> undefined     
+      _                                     -> undefined
 
 
 -- | To filter a Graph of Proximity using a given threshold
@@ -118,7 +115,7 @@ phyloToClusters lvl clus p = Map.fromList
     --------------------------------------
     graphs :: [([GroupNode],[GroupEdge])]
     graphs = traceGraph lvl (getThreshold prox)
-           $ let gs  = map (\prd -> groupsToGraph (periodsToNbDocs [prd] p) prox (getGroupsWithFilters lvl prd p)) periods
+           $ let gs  = (trace $ "PROX: " <> show prox) $ map (\prd -> groupsToGraph (periodsToNbDocs [prd] p) prox (getGroupsWithFilters lvl prd p)) periods
                  gs' = gs `using` parList rdeepseq
              in  gs'
     --------------------------------------