add trace to cluster and optimisation to find candidates

bin/gargantext-phylo/Main.hs

@@ -78,6 +78,10 @@ data Conf =
           , timeSens    :: Double
           , clusterTh   :: Double
           , clusterSens :: Double
+          , phyloLevel  :: Int
+          , viewLevel   :: Int
+          , fisSupport  :: Int
+          , fisClique   :: Int 
      } deriving (Show,Generic)
 
 instance FromJSON Conf
@@ -148,17 +152,13 @@ parse format limit path l = do
 main :: IO ()
 main = do 
 
-  putStrLn $ show ("--| Read the conf |--")
-
   [jsonPath] <- getArgs
 
   confJson <- (eitherDecode <$> getJson jsonPath) :: IO (P.Either P.String Conf)
 
   case confJson of
     P.Left err -> putStrLn err
-    P.Right conf -> do  
-
-      putStrLn $ show ("--| Parse the corpus |--")
+    P.Right conf -> do
 
       termList <- csvGraphTermList (listPath conf)
 
@@ -166,21 +166,19 @@ main = do
 
       let roots = DL.nub $ DL.concat $ map text corpus
 
-      putStrLn $ ("-- | parsed docs : " <> show (length corpus) <> " |--") 
-
-      putStrLn $ show ("--| Build the phylo |--")
+      putStrLn $ (show (length corpus) <> " parsed docs")
       
       let query = PhyloQueryBuild (phyloName conf) "" (timeGrain conf) (timeStep conf) 
-                  defaultFis [] [] (WeightedLogJaccard $ WLJParams (timeTh conf) (timeSens conf)) 2 
+                  (Fis $ FisParams True (fisSupport conf) (fisClique conf)) [] [] (WeightedLogJaccard $ WLJParams (timeTh conf) (timeSens conf)) (phyloLevel conf)
                   (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams (clusterTh conf) (clusterSens conf))
 
-      let queryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True           
+      let queryView = PhyloQueryView (viewLevel conf) Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True           
 
       let phylo = toPhylo query corpus roots termList
 
       let view  = toPhyloView queryView phylo
 
-      putStrLn $ show ("--| Export the phylo as a dot graph |--") 
+      putStrLn $ ("phylo completed until level " <> show (phyloLevel conf) <> ", export at level " <> show (viewLevel conf)) 
 
       let outputFile = (outputPath conf) <> (DT.unpack $ phyloName conf)
                                          <> "_" <> show (limit conf) <> "_"
@@ -190,4 +188,4 @@ main = do
                                          <> "_" <> show (clusterSens conf) 
                                          <> ".dot"
 
-      P.writeFile outputFile $ dotToString $ viewToDot view       
+      P.writeFile outputFile $ dotToString $ viewToDot view      

src/Gargantext/Viz/Phylo.hs

@@ -207,12 +207,12 @@ data PhyloFis = PhyloFis
 type PhyloCluster = [PhyloGroup]
 
 
--- | A List of PhyloGroup in a Graph
-type GroupNodes = [PhyloGroup]
--- | A List of weighted links between some PhyloGroups in a Graph
-type GroupEdges = [((PhyloGroup,PhyloGroup),Weight)]
+-- | A PhyloGroup in a Graph
+type GroupNode  = PhyloGroup
+-- | A weighted links between two PhyloGroups in a Graph
+type GroupEdge  = ((PhyloGroup,PhyloGroup),Weight)
 -- | The association as a Graph between a list of Nodes and a list of Edges
-type GroupGraph = (GroupNodes,GroupEdges)
+type GroupGraph = ([GroupNode],[GroupEdge])
 
 
 ---------------

src/Gargantext/Viz/Phylo/Aggregates/Cluster.hs

@@ -17,30 +17,95 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.Aggregates.Cluster
   where
 
-import Data.List        (null,tail)
+import Data.List        (null,tail,concat)
 import Data.Map         (Map)
 import Data.Tuple       (fst)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Tools
-import Gargantext.Viz.Phylo.BranchMaker
+import Gargantext.Viz.Phylo.Metrics.Proximity
 import Gargantext.Viz.Phylo.Metrics.Clustering
 import qualified Data.Map    as Map
 
+import qualified Data.Vector.Storable as VS
+import Debug.Trace (trace)
+import Numeric.Statistics (percentile)
 
--- | To apply a Clustering method to a PhyloGraph
+
+-- | To transform a Graph into Clusters
 graphToClusters :: Cluster -> GroupGraph -> [PhyloCluster]
 graphToClusters clust (nodes,edges) = case clust of
-  Louvain (LouvainParams _)      -> undefined -- louvain (nodes,edges)
-  RelatedComponents (RCParams _) -> relatedComp 0 (head' "graphToClusters" nodes) (tail nodes,edges) [] []
-  _                              -> panic "[ERR][Viz.Phylo.Aggregates.Cluster.graphToClusters] not implemented"
+      Louvain (LouvainParams _)      -> undefined
+      RelatedComponents (RCParams _) -> relatedComp 0 (head' "graphToClusters" nodes) (tail nodes,edges) [] []
+      _                              -> panic "[ERR][Viz.Phylo.Aggregates.Cluster.graphToClusters] not implemented"
+
+
+-- | To transform a list of PhyloGroups into a Graph of Proximity
+groupsToGraph :: Proximity -> [PhyloGroup] -> ([GroupNode],[GroupEdge])
+groupsToGraph prox gs = case prox of 
+      WeightedLogJaccard (WLJParams _ sens) -> (gs, map (\(x,y) -> ((x,y), weightedLogJaccard sens (getGroupCooc x) (getGroupCooc y)))                                               
+                                                      $ listToDirectedCombi gs)
+      Hamming (HammingParams _)             -> (gs, map (\(x,y) -> ((x,y), hamming (getGroupCooc x) (getGroupCooc y)))                                   
+                                                      $ listToDirectedCombi gs)
+      _                                     -> undefined 
+
 
--- | To transform a Phylo into Clusters of PhyloGroups at a given level
+-- | To filter a Graph of Proximity using a given threshold
+filterGraph :: Proximity -> ([GroupNode],[GroupEdge]) -> ([GroupNode],[GroupEdge])
+filterGraph prox (ns,es) = case prox of
+      WeightedLogJaccard (WLJParams thr _) -> (ns, filter (\(_,v) -> v >= thr) es)
+      Hamming (HammingParams thr)          -> (ns, filter (\(_,v) -> v <= thr) es)
+      _                                    -> undefined 
+
+
+-- | To clusterise a Phylo
 phyloToClusters :: Level -> Cluster -> Phylo -> Map (Date,Date) [PhyloCluster]
-phyloToClusters lvl clus p = Map.fromList
-                           $ zip (getPhyloPeriods p)
-                              (map (\prd -> let graph = groupsToGraph (getProximity clus) (getGroupsWithFilters lvl prd p) p
-                                            in if null (fst graph)
-                                              then []
-                                              else graphToClusters clus graph)
-                              (getPhyloPeriods p))
+phyloToClusters lvl clus p = Map.fromList 
+                            $ zip periods
+                            $ map (\g -> if null (fst g)
+                                         then []
+                                         else graphToClusters clus g) graphs'
+  where
+    --------------------------------------
+    graphs' :: [([GroupNode],[GroupEdge])]
+    graphs' = traceGraphFiltered lvl
+            $ map (\g -> filterGraph prox g) graphs
+    --------------------------------------
+    graphs  :: [([GroupNode],[GroupEdge])]
+    graphs  = traceGraph lvl (getThreshold prox) 
+            $ map (\prd -> groupsToGraph prox (getGroupsWithFilters lvl prd p)) periods 
+    --------------------------------------
+    prox :: Proximity
+    prox = getProximity clus
+    --------------------------------------
+    periods :: [PhyloPeriodId]
+    periods = getPhyloPeriods p
+    --------------------------------------
+
+
+----------------
+-- | Tracer | --
+----------------
+
+
+traceGraph :: Level -> Double -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
+traceGraph lvl thr g = trace ( "----\nUnfiltered clustering in Phylo" <> show (lvl) <> " :\n"
+                                      <> "count : " <> show (length lst) <> " potential edges (" <> show (length $ filter (>= thr) lst) <> " >= " <> show (thr) <> ")\n"
+                                      <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
+                                                         <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
+                                                         <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
+                                                         <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") g
+  where 
+    lst = map snd $ concat $ map snd g 
+
+
+traceGraphFiltered :: Level -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
+traceGraphFiltered lvl g = trace ( "----\nClustering in Phylo" <> show (lvl) <> " :\n"
+                                      <> "count : " <> show (length lst) <> " edges\n"
+                                      <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
+                                                         <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
+                                                         <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
+                                                         <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") g
+  where 
+    lst = map snd $ concat $ map snd g 
+

src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs

@@ -26,9 +26,9 @@ import qualified Data.Map    as Map
 import qualified Data.Set    as Set
 
 
--- | To transform the Fis into a coocurency Matrix in a Phylo
-fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
-fisToCooc m p = map   (/docs)
+-- | To transform the Fis into a coocurency Matrix in a Phylo but as a triangle  
+fisToCooc' :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
+fisToCooc' m p = map   (/docs)
               $ foldl (\mem x -> adjust (+1) (getKeyPair x mem) mem) cooc
               $ concat
               $ map (\x -> listToUnDirectedCombiWith (\y -> getIdxInRoots y p) $ (Set.toList . getClique) x)
@@ -46,5 +46,25 @@ fisToCooc m p = map   (/docs)
     --------------------------------------
 
 
+-- | To transform the Fis into a full coocurency Matrix in a Phylo
+fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
+fisToCooc m p = map (/docs)
+              $ foldl (\mem x -> adjust (+1) x mem) cooc
+              $ concat
+              $ map (\x -> listToDirectedCombiWith (\y -> getIdxInRoots y p) $ (Set.toList . getClique) x)
+              $ (concat . elems) m
+  where
+    --------------------------------------
+    fisNgrams :: [Ngrams]
+    fisNgrams = foldl (\mem x -> union mem $ (Set.toList . getClique) x) [] $ (concat . elems) m
+    --------------------------------------
+    docs :: Double
+    docs = fromIntegral $ foldl (\mem x -> mem + (getSupport x)) 0 $ (concat . elems) m
+    --------------------------------------
+    cooc :: Map (Int, Int) (Double)
+    cooc = Map.fromList $ map (\x -> (x,0)) (listToDirectedCombiWith (\y -> getIdxInRoots y p) fisNgrams)
+    --------------------------------------
+
+
 -- phyloCooc :: Map (Int, Int) Double
 -- phyloCooc = fisToCooc phyloFis phylo1_0_1

src/Gargantext/Viz/Phylo/BranchMaker.hs

@@ -20,11 +20,9 @@ module Gargantext.Viz.Phylo.BranchMaker
 import Control.Lens     hiding (both, Level)
 import Data.List        (concat,nub,(++),tail)
 import Data.Tuple       (fst, snd)
-import Data.Map         (Map,fromList,toList)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Metrics.Clustering
-import Gargantext.Viz.Phylo.Metrics.Proximity
 import Gargantext.Viz.Phylo.Tools
 -- import Debug.Trace (trace)
 
@@ -37,26 +35,16 @@ graphToBranches _lvl (nodes,edges) _p = concat
                                     $ relatedComp 0 (head' "branchMaker" nodes) (tail nodes,edges) [] []
 
 
-mirror :: Ord a => Map (a,a) b -> Map (a,a) b
-mirror m = fromList $ concat $ map (\((k,k'),v) -> [((k,k'),v),((k',k),v)]) $ toList m 
 
-
--- | To transform a list of PhyloGroups into a PhyloGraph by using a given Proximity mesure
-groupsToGraph :: Proximity -> [PhyloGroup] -> Phylo -> GroupGraph
-groupsToGraph prox groups p = (groups,edges)
-  where
-    edges :: GroupEdges
-    edges = case prox of
-      Filiation          -> (nub . concat) $ map (\g -> (map (\g' -> ((g',g),1)) $ getGroupParents g p)
-                                                        ++
-                                                        (map (\g' -> ((g,g'),1)) $ getGroupChilds g p)) groups
-      WeightedLogJaccard (WLJParams thr sens) -> filter (\(_,v) -> v >= thr)
-                                               $ map (\(x,y) -> ((x,y), weightedLogJaccard sens (mirror $ getGroupCooc x) (mirror $ getGroupCooc y)))
-                                               $ listToDirectedCombi groups
-      Hamming (HammingParams thr) -> filter (\edge -> snd edge <= thr)
-                                   $ map (\(x,y) -> ((x,y), hamming (getGroupCooc x) (unifySharedKeys (getGroupCooc x) (getGroupCooc y))))
-                                   $ listToDirectedCombi groups
-      --_                  -> undefined
+-- | To build a graph using the parents and childs pointers
+makeGraph :: [PhyloGroup] -> Phylo -> GroupGraph
+makeGraph gs p = (gs,edges)
+  where 
+    edges :: [GroupEdge]
+    edges = (nub . concat) 
+          $ map (\g -> (map (\g' -> ((g',g),1)) $ getGroupParents g p)
+                       ++
+                       (map (\g' -> ((g,g'),1)) $ getGroupChilds g p)) gs
 
 
 -- | To set all the PhyloBranches for a given Level in a Phylo
@@ -69,5 +57,5 @@ setPhyloBranches lvl p = alterGroupWithLevel (\g -> let bIdx = (fst $ head' "bra
     bs = graphToBranches lvl graph p
     --------------------------------------
     graph :: GroupGraph
-    graph = groupsToGraph Filiation (getGroupsWithLevel lvl p) p
+    graph = makeGraph (getGroupsWithLevel lvl p) p
     --------------------------------------

src/Gargantext/Viz/Phylo/Example.hs

@@ -104,7 +104,7 @@ queryEx = "title=Cesar et Cleôpatre"
 
 phyloQueryBuild :: PhyloQueryBuild
 phyloQueryBuild = PhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
-             5 3 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.1 10) 3 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.05 10)
+             5 3 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.1 10) 2 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.1 10)
 
 
 

src/Gargantext/Viz/Phylo/LevelMaker.hs

@@ -270,14 +270,13 @@ instance PhyloMaker [Document]
 
 
 tracePhyloBase :: Phylo -> Phylo
-tracePhyloBase p = trace ( "----\nPhyloBase : \n" 
+tracePhyloBase p = trace ( "\n-----------------\n--| PhyloBase |--\n-----------------\n\n" 
                         <> show (length $ _phylo_periods p) <> " periods from " 
                                  <> show (getPhyloPeriodId $ (head' "PhyloMaker") $ _phylo_periods p)
                                  <> " to " 
                                  <> show (getPhyloPeriodId $ last $ _phylo_periods p)
                                  <> "\n"
                         <> show ( Vector.length $ getFoundationsRoots p) <> " foundations roots \n") p
-                          
 
 
 traceTempoMatching :: Filiation -> Level -> Phylo -> Phylo
@@ -299,7 +298,7 @@ traceTempoMatching fil lvl p = trace ( "----\n" <> show (fil) <> " filtered temp
 
 traceBranches :: Level -> Phylo -> Phylo
 traceBranches lvl p = trace ( "----\n" <> "Branches in Phylo" <> show lvl <> " :\n"
-                           <> "count : " <> show (length $ getBranchIds p) <> " branches\n"
+                           <> "count : " <> show (length $ filter (\(lvl',_) -> lvl' == lvl ) $ getBranchIds p) <> " branches\n"
                            <> "count : " <> show (length $ getGroupsWithLevel lvl p)    <> " groups\n"
                            <> "groups by branch : " <> show (percentile 25 (VS.fromList brs)) <> " (25%) "
                                                     <> show (percentile 50 (VS.fromList brs)) <> " (50%) "

src/Gargantext/Viz/Phylo/LinkMaker.hs

@@ -18,7 +18,7 @@ module Gargantext.Viz.Phylo.LinkMaker
   where
 
 import Control.Lens                 hiding (both, Level)
-import Data.List                    ((++), sortOn, null, tail, splitAt, elem, concat, sort, delete)
+import Data.List                    ((++), sortOn, null, tail, splitAt, elem, concat, sort, delete, intersect)
 import Data.Tuple.Extra
 import Data.Map                     (Map,(!))
 import Gargantext.Prelude
@@ -68,17 +68,16 @@ linkGroupToGroups (lvl,lvl') current targets
     --------------------------------------
 
 
--- | To set the LevelLinks between two lists of PhyloGroups
-linkGroupsByLevel :: (Level,Level) -> Phylo -> [PhyloGroup] -> [PhyloGroup]
-linkGroupsByLevel (lvl,lvl') p groups  = map (\group ->
-                                              if getGroupLevel group == lvl
-                                              then linkGroupToGroups (lvl,lvl') group (getGroupsWithFilters lvl' (getGroupPeriod group) p)
-                                              else group) groups
-
-
 -- | To set the LevelLink of all the PhyloGroups of a Phylo
 setLevelLinks :: (Level,Level) -> Phylo -> Phylo
-setLevelLinks (lvl,lvl') p = alterPhyloGroups (linkGroupsByLevel (lvl,lvl') p) p
+setLevelLinks (lvl,lvl') p = alterPhyloGroups (\gs -> map (\g -> if getGroupLevel g == lvl
+                                                                  then linkGroupToGroups (lvl,lvl') g (filter (\g' -> getGroupPeriod g' == getGroupPeriod g) gs')
+                                                                  else g) gs) p
+  where
+    --------------------------------------
+    gs' :: [PhyloGroup]
+    gs' = getGroupsWithLevel lvl' p
+    --------------------------------------
 
 
 ------------------------------------------------------------------------
@@ -88,8 +87,10 @@ setLevelLinks (lvl,lvl') p = alterPhyloGroups (linkGroupsByLevel (lvl,lvl') p) p
 -- | To apply the corresponding proximity function based on a given Proximity
 applyProximity :: Proximity -> PhyloGroup -> PhyloGroup -> (PhyloGroupId, Double)
 applyProximity prox g1 g2 = case prox of
-  WeightedLogJaccard (WLJParams _ s) -> ((getGroupId g2),weightedLogJaccard s (getGroupCooc g1) (unifySharedKeys (getGroupCooc g2) (getGroupCooc g1)))
-  Hamming (HammingParams _)          -> ((getGroupId g2),hamming (getGroupCooc g1) (unifySharedKeys (getGroupCooc g2) (getGroupCooc g1)))
+  -- WeightedLogJaccard (WLJParams _ s) -> ((getGroupId g2),weightedLogJaccard s (getGroupCooc g1) (unifySharedKeys (getGroupCooc g2) (getGroupCooc g1)))
+  -- Hamming (HammingParams _)          -> ((getGroupId g2),hamming (getGroupCooc g1) (unifySharedKeys (getGroupCooc g2) (getGroupCooc g1)))  
+  WeightedLogJaccard (WLJParams _ s) -> ((getGroupId g2), weightedLogJaccard s (getGroupCooc g1) (getGroupCooc g2))
+  Hamming (HammingParams _)          -> ((getGroupId g2), hamming (getGroupCooc g1) (getGroupCooc g2))
   _                                  -> panic ("[ERR][Viz.Phylo.Example.applyProximity] Proximity function not defined")
 
 
@@ -152,13 +153,20 @@ addPointers' fil pts g = g & case fil of
 updateGroups :: Filiation -> Level -> Map PhyloGroupId [Pointer] -> Phylo -> Phylo 
 updateGroups fil lvl m p = alterPhyloGroups (\gs -> map (\g -> if (getGroupLevel g) == lvl
                                                                then addPointers' fil (m ! (getGroupId g)) g
-                                                                else g ) gs) p
+                                                               else g ) gs) p
+
+
+
+-- | Optimisation : to keep only the groups that have at least one ngrams in commons with the target
+filterCandidates :: PhyloGroup -> [PhyloGroup] -> [PhyloGroup]
+filterCandidates g gs = filter (\g' -> (not . null) $ intersect (getGroupNgrams g) (getGroupNgrams g'))
+                      $ delete g gs  
 
 
 
 -- | To apply the intertemporal matching to Phylo at a given level
 interTempoMatching :: Filiation -> Level -> Proximity -> Phylo -> Phylo
-interTempoMatching fil lvl prox p = traceMatching fil lvl scores
+interTempoMatching fil lvl prox p = traceMatching fil lvl (getThreshold prox) scores
                                   $ updateGroups fil lvl pointers p
   where
     --------------------------------------
@@ -167,9 +175,9 @@ interTempoMatching fil lvl prox p = traceMatching fil lvl scores
     --------------------------------------
     scores :: [Double]
     scores = sort $ concat $ map (snd . snd) candidates 
-    -------------------------------------- 
+    --------------------------------------     
     candidates :: [(PhyloGroupId,([Pointer],[Double]))]
-    candidates = map (\g -> ( getGroupId g, findBestCandidates' fil 1 5 prox (getNextPeriods fil (getGroupPeriod g) prds) (delete g gs) g)) gs
+    candidates = map (\g -> ( getGroupId g, findBestCandidates' fil 1 5 prox (getNextPeriods fil (getGroupPeriod g) prds) (filterCandidates g gs) g)) gs
     --------------------------------------
     gs :: [PhyloGroup]
     gs = getGroupsWithLevel lvl p
@@ -184,9 +192,9 @@ interTempoMatching fil lvl prox p = traceMatching fil lvl scores
 ----------------
 
 
-traceMatching :: Filiation -> Level -> [Double] -> Phylo -> Phylo
-traceMatching fil lvl lst p = trace ( "----\n" <> show (fil) <> " unfiltered temporal Matching in Phylo" <> show (lvl) <> " :\n"
-                                      <> "count : " <> show (length lst) <> " potential pointers\n"
+traceMatching :: Filiation -> Level -> Double -> [Double] -> Phylo -> Phylo
+traceMatching fil lvl thr lst p = trace ( "----\n" <> show (fil) <> " unfiltered temporal Matching in Phylo" <> show (lvl) <> " :\n"
+                                      <> "count : " <> show (length lst) <> " potential pointers (" <> show (length $ filter (>= thr) lst) <> " >= " <> show (thr) <> ")\n"
                                       <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
                                                          <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
                                                          <> show (percentile 75 (VS.fromList lst)) <> " (75%) "

src/Gargantext/Viz/Phylo/Metrics/Clustering.hs

@@ -50,7 +50,7 @@ relatedComp idx curr (nodes,edges) next memo
     --------------------------------------
 
 
-louvain :: (GroupNodes,GroupEdges) -> IO [[PhyloGroup]]
+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)

src/Gargantext/Viz/Phylo/Tools.hs

@@ -471,12 +471,12 @@ getSupport = _phyloFis_support
 
 
 -- | To filter some GroupEdges with a given threshold
-filterGroupEdges :: Double -> GroupEdges -> GroupEdges
+filterGroupEdges :: Double -> [GroupEdge] -> [GroupEdge]
 filterGroupEdges thr edges = filter (\((_s,_t),w) -> w > thr) edges
 
 
 -- | To get the neighbours (directed/undirected) of a PhyloGroup from a list of GroupEdges
-getNeighbours :: Bool -> PhyloGroup -> GroupEdges -> [PhyloGroup]
+getNeighbours :: Bool -> PhyloGroup -> [GroupEdge] -> [PhyloGroup]
 getNeighbours directed g e = case directed of
   True  -> map (\((_s,t),_w) -> t)
              $ filter (\((s,_t),_w) -> s == g) e
@@ -686,6 +686,13 @@ getPeriodSteps q = q ^. q_periodSteps
 -- | PhyloQueryBuild & PhyloQueryView Constructors | --
 --------------------------------------------------
 
+-- | To get the threshold of a Proximity
+getThreshold :: Proximity -> Double
+getThreshold prox = case prox of 
+  WeightedLogJaccard (WLJParams thr _) -> thr
+  Hamming (HammingParams thr)          -> thr
+  Filiation                            -> panic "[ERR][Viz.Phylo.Tools.getThreshold] Filiation"
+
 
 -- | To get the Proximity associated to a given Clustering method
 getProximity :: Cluster -> Proximity
@@ -702,8 +709,11 @@ initFis (def True -> kmf) (def 1 -> min') (def 1 -> thr) = FisParams kmf min' th
 initHamming :: Maybe Double -> HammingParams
 initHamming (def 0.01 -> sens) = HammingParams sens
 
+initSmallBranch' :: Maybe Int -> Maybe Int -> Maybe Int -> SBParams
+initSmallBranch' (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = SBParams periodsInf periodsSup minNodes
+
 initSmallBranch :: Maybe Int -> Maybe Int -> Maybe Int -> SBParams
-initSmallBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = SBParams periodsInf periodsSup minNodes
+initSmallBranch (def 0 -> periodsInf) (def 0 -> periodsSup) (def 1 -> minNodes) = SBParams periodsInf periodsSup minNodes
 
 initLouvain :: Maybe Proximity -> LouvainParams
 initLouvain (def defaultWeightedLogJaccard -> proxi) = LouvainParams proxi