[MERGE]

src/Gargantext/Core/Viz/Phylo.hs

@@ -30,8 +30,7 @@ import Control.DeepSeq (NFData)
 import Control.Lens (makeLenses)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
-import Data.Map.Strict (Map)
-import Data.Set (Set)
+import Data.Map (Map)
 import Data.Swagger
 import Data.Text   (Text, pack)
 import Data.Vector (Vector)
@@ -64,9 +63,9 @@ instance ToSchema ListParser
 data SeaElevation =
       Constante
       { _cons_start :: Double
-      , _cons_gap   :: Double }
+      , _cons_step  :: Double }
     | Adaptative
-      { _adap_steps :: Double }
+      { _adap_granularity :: Double }
     deriving (Show,Generic,Eq)
 
 instance ToSchema SeaElevation
@@ -307,8 +306,8 @@ instance ToSchema Software where
 
 defaultSoftware :: Software
 defaultSoftware =
-      Software { _software_name    = pack "GarganText"
-               , _software_version = pack "v5" }
+      Software { _software_name    = pack "Gargantext"
+               , _software_version = pack "v4" }
 
 
 -- | Global parameters of a Phylo
@@ -325,7 +324,7 @@ instance ToSchema PhyloParam where
 
 defaultPhyloParam :: PhyloParam
 defaultPhyloParam =
-      PhyloParam { _phyloParam_version  = pack "v3"
+      PhyloParam { _phyloParam_version  = pack "v2.adaptative"
                  , _phyloParam_software = defaultSoftware
                  , _phyloParam_config   = defaultConfig }
 
@@ -410,7 +409,8 @@ data Phylo =
            , _phylo_timeDocs     :: !(Map Date Double)
            , _phylo_termFreq     :: !(Map Int Double)
            , _phylo_lastTermFreq :: !(Map Int Double)
-           , _phylo_diaSimScan   :: Set Double
+           , _phylo_horizon      :: !(Map (PhyloGroupId,PhyloGroupId) Double)
+           , _phylo_groupsProxi  :: !(Map (PhyloGroupId,PhyloGroupId) Double)
            , _phylo_param        :: PhyloParam
            , _phylo_periods      :: Map Period PhyloPeriod
            , _phylo_quality      :: Double

src/Gargantext/Core/Viz/Phylo/Example.hs

@@ -18,7 +18,7 @@ module Gargantext.Core.Viz.Phylo.Example where
 import Control.Lens
 import Data.GraphViz.Types.Generalised (DotGraph)
 import Data.List (sortOn, nub, sort)
-import Data.Map.Strict (Map)
+import Data.Map (Map)
 import Data.Text (Text, toLower)
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Terms.Mono (monoTexts)
@@ -27,10 +27,9 @@ import Gargantext.Core.Viz.Phylo.PhyloExport
 import Gargantext.Core.Viz.Phylo.PhyloMaker
 import Gargantext.Core.Viz.Phylo.PhyloTools
 import Gargantext.Core.Viz.Phylo.SynchronicClustering (synchronicClustering)
-import Gargantext.Core.Viz.Phylo.TemporalMatching (temporalMatching)
+import Gargantext.Core.Viz.Phylo.TemporalMatching (adaptativeTemporalMatching, constanteTemporalMatching)
 import Gargantext.Prelude
 import qualified Data.Vector as Vector
-import qualified Data.Set as Set
 
 ---------------------------------
 -- | STEP 5 | -- Export the phylo
@@ -55,15 +54,14 @@ phyloCleopatre = synchronicClustering $ toHorizon flatPhylo
 
 flatPhylo :: Phylo
 flatPhylo = case (getSeaElevation emptyPhylo) of 
-    Constante s g   -> temporalMatching (constDiachronicLadder s g Set.empty)
-       $ scanSimilarity 1
+    Constante s g   -> constanteTemporalMatching s g 
+       $ toGroupsProxi 1
        $ appendGroups clusterToGroup 1 seriesOfClustering emptyPhylo
-    Adaptative s    -> temporalMatching (adaptDiachronicLadder s (emptyPhylo' ^. phylo_diaSimScan) Set.empty) emptyPhylo'
-
-emptyPhylo' :: Phylo
-emptyPhylo' = scanSimilarity 1
+    Adaptative s    -> adaptativeTemporalMatching s
+       $ toGroupsProxi 1
        $ appendGroups clusterToGroup 1 seriesOfClustering emptyPhylo
 
+
 ---------------------------------------------
 -- | STEP 2 | -- Build the cliques
 ---------------------------------------------
@@ -104,7 +102,6 @@ config :: PhyloConfig
 config = 
     defaultConfig { phyloName  = "Cesar et Cleopatre"
                   , phyloScale = 2
-                  , seaElevation   = Adaptative 4
                   , exportFilter = [ByBranchSize 0]
                   , clique = MaxClique 0 15 ByNeighbours }
 

src/Gargantext/Core/Viz/Phylo/PhyloExport.hs

@@ -19,7 +19,7 @@ import Data.GraphViz.Attributes.Complete hiding (EdgeType, Order)
 import Data.GraphViz.Types.Generalised (DotGraph)
 import Data.GraphViz.Types.Monadic
 import Data.List ((++), sort, nub, null, concat, sortOn, groupBy, union, (\\), (!!), init, partition, notElem, unwords, nubBy, inits, elemIndex)
-import Data.Map.Strict (Map, fromList, empty, fromListWith, insert, (!), elems, unionWith, findWithDefault, toList, member)
+import Data.Map (Map, fromList, empty, fromListWith, insert, (!), elems, unionWith, findWithDefault, toList, member)
 import Data.Text.Lazy (fromStrict, pack, unpack)
 import Data.Vector (Vector)
 import Debug.Trace (trace)
@@ -546,10 +546,9 @@ processLabels labels foundations freq export =
 -- | Dynamics | --
 ------------------
 
--- utiliser & creer une Map FdtId [PhyloGroup]
--- n = index of the current term
-toDynamics :: FdtId -> [PhyloGroup] -> PhyloGroup -> Map FdtId (Date,Date) -> Double
-toDynamics n elders g m =
+
+toDynamics :: Int -> [PhyloGroup] -> PhyloGroup -> Map Int (Date,Date) -> Double
+toDynamics n parents g m =
     let prd = g ^. phylo_groupPeriod
         end = last' "dynamics" (sort $ map snd $ elems m)
     in  if (((snd prd) == (snd $ m ! n)) && (snd prd /= end))
@@ -565,18 +564,18 @@ toDynamics n elders g m =
     where
         --------------------------------------
         isNew :: Bool
-        isNew = not $ elem n $ concat $ map _phylo_groupNgrams elders
+        isNew = not $ elem n $ concat $ map _phylo_groupNgrams parents
+
 
-type FdtId = Int
 processDynamics :: [PhyloGroup] -> [PhyloGroup]
 processDynamics groups =
     map (\g ->
-        let elders = filter (\g' -> (g ^. phylo_groupBranchId == g' ^. phylo_groupBranchId)
+        let parents = filter (\g' -> (g ^. phylo_groupBranchId == g' ^. phylo_groupBranchId)
                                   && ((fst $ g ^. phylo_groupPeriod) > (fst $ g' ^. phylo_groupPeriod))) groups
-        in  g & phylo_groupMeta %~ insert "dynamics" (map (\n -> toDynamics n elders g mapNgrams) $ g ^. phylo_groupNgrams) ) groups
+        in  g & phylo_groupMeta %~ insert "dynamics" (map (\n -> toDynamics n parents g mapNgrams) $ g ^. phylo_groupNgrams) ) groups
     where
         --------------------------------------
-        mapNgrams :: Map FdtId (Date,Date)
+        mapNgrams :: Map Int (Date,Date)
         mapNgrams = map (\dates ->
                         let dates' = sort dates
                         in (head' "dynamics" dates', last' "dynamics" dates'))
@@ -622,7 +621,7 @@ toHorizon phylo =
                               $ concat
                               $ tracePhyloAncestors newGroups) phylo
       reBranched = fromList $ map (\g -> (getGroupId g, g)) $ concat
-                 $ groupsToBranches' $ fromList $ map (\g -> (getGroupId g, g)) $ getGroupsFromScale scale phyloAncestor
+                 $ groupsToBranches' $ fromList $ map (\g -> (getGroupId g, g)) $ getGroupsFromLevel scale phyloAncestor
    in updatePhyloGroups scale reBranched phylo
   where
     -- | 1) for each periods
@@ -637,7 +636,7 @@ toHorizon phylo =
     -- | 2) find ancestors between groups without parents
     mapGroups :: [[PhyloGroup]]
     mapGroups = map (\prd ->
-      let groups  = getGroupsFromScalePeriods scale [prd] phylo
+      let groups  = getGroupsFromLevelPeriods scale [prd] phylo
           childs  = getPreviousChildIds scale frame prd periods phylo
               -- maybe add a better filter for non isolated  ancestors
           heads   = filter (\g -> (not . null) $ (g ^. phylo_groupPeriodChilds))
@@ -661,7 +660,7 @@ toHorizon phylo =
 getPreviousChildIds :: Scale -> Int -> Period -> [Period] -> Phylo -> [PhyloGroupId]
 getPreviousChildIds lvl frame curr prds phylo =
     concat $ map ((map fst) . _phylo_groupPeriodChilds)
-           $ getGroupsFromScalePeriods lvl (getNextPeriods ToParents frame curr prds) phylo
+           $ getGroupsFromLevelPeriods lvl (getNextPeriods ToParents frame curr prds) phylo
 
 ---------------------
 -- | phyloExport | --
@@ -696,10 +695,10 @@ toPhyloExport phylo = exportToDot phylo
         --------------------------------------
         groups :: [PhyloGroup]
         groups = traceExportGroups
-               -- necessaire ?
                $ processDynamics
-               $ getGroupsFromScale (phyloScale $ getConfig phylo)
+               $ getGroupsFromLevel (phyloScale $ getConfig phylo)
                $ tracePhyloInfo phylo
+               -- \$ toHorizon phylo
 
 
 traceExportBranches :: [PhyloBranch] -> [PhyloBranch]
@@ -722,3 +721,4 @@ traceExportGroups groups = trace ("\n" <> "-- | Export "
     <> show(length groups) <> " groups and "
     <> show(length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) groups) <> " terms"
   ) groups
+

src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs

@@ -8,18 +8,18 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+
 module Gargantext.Core.Viz.Phylo.PhyloMaker where
 
+
 import Control.DeepSeq (NFData)
 import Control.Lens hiding (Level)
 import Control.Parallel.Strategies (parList, rdeepseq, using)
 import Data.List (concat, nub, partition, sort, (++), group, intersect, null, sortOn, groupBy, tail)
-import Data.Map.Strict (Map, fromListWith, keys, unionWith, fromList, empty, toList, elems, (!), restrictKeys, foldlWithKey, insert)
-import Data.Set (Set)
+import Data.Map (Map, fromListWith, keys, unionWith, fromList, empty, toList, elems, (!), restrictKeys, foldlWithKey, insert)
 import Data.Text (Text)
 import Data.Vector (Vector)
 import Debug.Trace (trace)
-import Prelude (floor)
 
 import Gargantext.Core.Methods.Similarities (Similarity(Conditional))
 import Gargantext.Core.Methods.Graph.MaxClique (getMaxCliques)
@@ -29,7 +29,7 @@ import Gargantext.Core.Viz.Phylo
 import Gargantext.Core.Viz.Phylo.PhyloExport (toHorizon)
 import Gargantext.Core.Viz.Phylo.PhyloTools
 import Gargantext.Core.Viz.Phylo.SynchronicClustering (synchronicClustering)
-import Gargantext.Core.Viz.Phylo.TemporalMatching (temporalMatching, getNextPeriods, filterDocs, filterDiago, reduceDiagos, toProximity)
+import Gargantext.Core.Viz.Phylo.TemporalMatching (adaptativeTemporalMatching, constanteTemporalMatching, getNextPeriods, filterDocs, filterDiago, reduceDiagos, toProximity)
 import Gargantext.Prelude
 
 import qualified Data.Set as Set
@@ -50,14 +50,12 @@ toPhylo' (PhyloN    phylo) = toPhylo'
 toPhylo' (PhyloBase phylo) = toPhylo 
 -}
 
--- TODO an adaptative synchronic clustering with a slider
-
 toPhylo :: Phylo -> Phylo
-toPhylo phylowithoutLink = trace ("# flatPhylo groups " <> show(length $ getGroupsFromScale 1 flatPhylo))
+toPhylo phylowithoutLink = trace ("# flatPhylo groups " <> show(length $ getGroupsFromLevel 1 flatPhylo))
                       $ traceToPhylo (phyloScale $ getConfig phylowithoutLink) $
     if (phyloScale $ getConfig phylowithoutLink) > 1
       then foldl' (\phylo' _ -> synchronicClustering phylo') phyloAncestors [2..(phyloScale $ getConfig phylowithoutLink)]
-      else phyloAncestors
+      else flatPhylo 
     where
         --------------------------------------
         phyloAncestors :: Phylo
@@ -71,41 +69,14 @@ toPhylo phylowithoutLink = trace ("# flatPhylo groups " <> show(length $ getGrou
         --------------------------------------
 
 
------------------------------
--- | Create a flat Phylo | --
------------------------------
-
-{-
--- create an adaptative diachronic 'sea elevation' ladder
--}
-adaptDiachronicLadder :: Double -> Set Double -> Set Double -> [Double]
-adaptDiachronicLadder curr similarities ladder =
-  if curr <= 0 || Set.null similarities
-    then Set.toList ladder
-    else
-      let idx = ((Set.size similarities) `div` (floor curr)) - 1
-          thr = Set.elemAt idx similarities
-      -- we use a sliding methods 1/10, then 1/9, then ... 1/2
-      in adaptDiachronicLadder (curr -1) (Set.filter (> thr) similarities) (Set.insert thr ladder)
-
-
-{-
--- create a constante diachronic 'sea elevation' ladder
--}
-constDiachronicLadder :: Double -> Double -> Set Double -> [Double]
-constDiachronicLadder curr step ladder =
-  if curr > 1
-    then Set.toList ladder
-    else constDiachronicLadder (curr + step) step (Set.insert curr ladder)
-
+--------------------
+-- | To Phylo 1 | --
+--------------------
 
-{-
--- process an initial scanning of the kinship links
--}
-scanSimilarity :: Scale -> Phylo -> Phylo
-scanSimilarity lvl phylo =
+toGroupsProxi :: Scale -> Phylo -> Phylo
+toGroupsProxi lvl phylo = 
   let proximity = phyloProximity $ getConfig phylo
-      scanning  = foldlWithKey (\acc pId pds ->
+      groupsProxi = foldlWithKey (\acc pId pds -> 
                       -- 1) process period by period
                       let egos = map (\g -> (getGroupId g, g ^. phylo_groupNgrams))
                                $ elems 
@@ -113,7 +84,7 @@ scanSimilarity lvl phylo =
                                       . traverse . filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == lvl) 
                                       . phylo_scaleGroups ) pds
                           next    = getNextPeriods ToParents (getTimeFrame $ timeUnit $ getConfig phylo) pId (keys $ phylo ^. phylo_periods)
-                          targets = map (\g ->  (getGroupId g, g ^. phylo_groupNgrams)) $ getGroupsFromScalePeriods lvl next phylo
+                          targets = map (\g ->  (getGroupId g, g ^. phylo_groupNgrams)) $ getGroupsFromLevelPeriods lvl next phylo
                           docs    = filterDocs  (phylo ^. phylo_timeDocs) ([pId] ++ next)
                           diagos  = filterDiago (phylo ^. phylo_timeCooc) ([pId] ++ next)
                           -- 2) compute the pairs in parallel
@@ -127,8 +98,7 @@ scanSimilarity lvl phylo =
                           pairs' = pairs `using` parList rdeepseq
                        in acc ++ (concat pairs')
                     ) [] $ phylo ^. phylo_periods
-   in phylo & phylo_diaSimScan .~ Set.fromList (traceGroupsProxi $ map snd scanning)
-
+   in phylo & phylo_groupsProxi .~ ((traceGroupsProxi . fromList) groupsProxi) 
 
 
 appendGroups :: (a -> Period -> (Text,Text) -> Scale -> Int -> [Cooc] -> PhyloGroup) -> Scale -> Map (Date,Date) [a] -> Phylo -> Phylo
@@ -164,16 +134,11 @@ clusterToGroup fis pId pId' lvl idx coocs = PhyloGroup pId pId' lvl idx ""
                    (fromList [("breaks",[0]),("seaLevels",[0])])
                    [] [] [] [] [] [] []
 
-{-
--- enhance the phylo with temporal links
--}
+
 addTemporalLinksToPhylo :: Phylo -> Phylo
-addTemporalLinksToPhylo phylowithoutLink = case strategy of
-    Constante start gap -> temporalMatching (constDiachronicLadder start gap Set.empty) phylowithoutLink
-    Adaptative steps    -> temporalMatching (adaptDiachronicLadder steps (phylowithoutLink ^. phylo_diaSimScan) Set.empty) phylowithoutLink
-  where
-    strategy :: SeaElevation
-    strategy = getSeaElevation phylowithoutLink
+addTemporalLinksToPhylo phylowithoutLink = case (getSeaElevation phylowithoutLink) of 
+    Constante start gap -> constanteTemporalMatching  start gap phylowithoutLink
+    Adaptative steps    -> adaptativeTemporalMatching steps phylowithoutLink
 
 -----------------------
 -- | To Phylo Step | --
@@ -198,7 +163,7 @@ indexDates' m = map (\docs ->
 toPhyloWithoutLink :: [Document] -> TermList -> PhyloConfig -> Phylo
 toPhyloWithoutLink docs lst conf = case (getSeaElevation phyloBase) of 
     Constante  _ _ -> appendGroups clusterToGroup 1 seriesOfClustering (updatePeriods (indexDates' docs') phyloBase)
-    Adaptative _   -> scanSimilarity 1
+    Adaptative _   -> toGroupsProxi 1 
                     $ appendGroups clusterToGroup 1 seriesOfClustering (updatePeriods (indexDates' docs') phyloBase)
     where
         --------------------------------------
@@ -411,7 +376,8 @@ initPhylo docs lst conf =
                (docsToTimeScaleNb docs)
                (docsToTermFreq docs (foundations ^. foundations_roots))
                (docsToLastTermFreq (getTimePeriod $ timeUnit conf) docs (foundations ^. foundations_roots))
-               Set.empty
+               empty
+               empty
                params
                (fromList $ map (\prd -> (prd, PhyloPeriod prd ("","") (initPhyloScales 1 prd))) periods)
                0

src/Gargantext/Core/Viz/Phylo/PhyloTools.hs

@@ -14,7 +14,7 @@ module Gargantext.Core.Viz.Phylo.PhyloTools where
 
 import Control.Lens hiding (Level)
 import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, group, notElem)
-import Data.Map.Strict (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
+import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
 import Data.Set (Set, disjoint)
 import Data.String (String)
 import Data.Text (Text,unpack)
@@ -25,6 +25,7 @@ import Gargantext.Prelude
 import Prelude (floor,read)
 import Text.Printf
 import qualified Data.List as List
+import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Vector as Vector
@@ -139,7 +140,6 @@ periodsToYears periods = (Set.fromList . sort . concat)
 
 
 findBounds :: [Date] -> (Date,Date)
-findBounds [] = panic "[G.C.V.P.PhyloTools] empty dates for find bounds"
 findBounds dates =
     let dates' = sort dates
     in  (head' "findBounds" dates', last' "findBounds" dates')
@@ -387,10 +387,10 @@ getLevelParentId :: PhyloGroup -> PhyloGroupId
 getLevelParentId g = fst $ head' "getLevelParentId" $ g ^. phylo_groupScaleParents
 
 getLastLevel :: Phylo -> Scale
-getLastLevel phylo = last' "lastLevel" $ getScales phylo
+getLastLevel phylo = last' "lastLevel" $ getLevels phylo
 
-getScales :: Phylo -> [Scale]
-getScales phylo = nub
+getLevels :: Phylo -> [Scale]
+getLevels phylo = nub
                 $ map snd
                 $ keys $ view ( phylo_periods
                        .  traverse
@@ -431,16 +431,14 @@ getRoots phylo = (phylo ^. phylo_foundations) ^. foundations_roots
 getSources :: Phylo -> Vector Text
 getSources phylo = _sources (phylo ^. phylo_sources)
 
-
--- get the groups distributed by branches at the last scale
-phyloLastScale :: Phylo -> [[PhyloGroup]]
-phyloLastScale phylo = elems
+phyloToLastBranches :: Phylo -> [[PhyloGroup]]
+phyloToLastBranches phylo = elems
     $ fromListWith (++)
     $ map (\g -> (g ^. phylo_groupBranchId, [g]))
-    $ getGroupsFromScale (last' "byBranches" $ getScales phylo) phylo
+    $ getGroupsFromLevel (last' "byBranches" $ getLevels phylo) phylo
 
-getGroupsFromScale :: Scale -> Phylo -> [PhyloGroup]
-getGroupsFromScale lvl phylo =
+getGroupsFromLevel :: Scale -> Phylo -> [PhyloGroup]
+getGroupsFromLevel lvl phylo =
     elems $ view ( phylo_periods
                  .  traverse
                  . phylo_periodScales
@@ -449,8 +447,8 @@ getGroupsFromScale lvl phylo =
                  . phylo_scaleGroups ) phylo
 
 
-getGroupsFromScalePeriods :: Scale -> [Period] -> Phylo -> [PhyloGroup]
-getGroupsFromScalePeriods lvl periods phylo =
+getGroupsFromLevelPeriods :: Scale -> [Period] -> Phylo -> [PhyloGroup]
+getGroupsFromLevelPeriods lvl periods phylo =
     elems $ view ( phylo_periods
                  .  traverse
                  .  filtered (\phyloPrd -> elem (phyloPrd ^. phylo_periodPeriod) periods)
@@ -502,8 +500,8 @@ updateQuality quality phylo = phylo { _phylo_quality = quality }
 traceToPhylo :: Scale -> Phylo -> Phylo
 traceToPhylo lvl phylo =
     trace ("\n" <> "-- | End of phylo making at level " <> show (lvl) <> " with "
-                <> show (length $ getGroupsFromScale lvl phylo) <> " groups and "
-                <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale lvl phylo) <> " branches" <> "\n") phylo
+                <> show (length $ getGroupsFromLevel lvl phylo) <> " groups and "
+                <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel lvl phylo) <> " branches" <> "\n") phylo
 
 --------------------
 -- | Clustering | --
@@ -566,15 +564,15 @@ toRelatedComponents nodes edges =
 traceSynchronyEnd :: Phylo -> Phylo
 traceSynchronyEnd phylo =
     trace ( "-- | End synchronic clustering at level " <> show (getLastLevel phylo)
-                 <> " with " <> show (length $ getGroupsFromScale (getLastLevel phylo) phylo) <> " groups"
-                 <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale (getLastLevel phylo) phylo) <> " branches"
+                 <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
+                 <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
                  <> "\n" ) phylo
 
 traceSynchronyStart :: Phylo -> Phylo
 traceSynchronyStart phylo =
     trace ( "\n" <> "-- | Start synchronic clustering at level " <> show (getLastLevel phylo)
-                 <> " with " <> show (length $ getGroupsFromScale (getLastLevel phylo) phylo) <> " groups"
-                 <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale (getLastLevel phylo) phylo) <> " branches"
+                 <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
+                 <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
                  <> "\n" ) phylo
 
 
@@ -661,6 +659,6 @@ traceTemporalMatching groups =
     trace ( "\n" <> "-- | Start temporal matching for " <> show(length groups) <> " groups" <> "\n") groups
 
 
-traceGroupsProxi :: [Double] -> [Double]
-traceGroupsProxi l =
-    trace ( "\n" <> "-- | " <> show(List.length l) <> " computed pairs of groups proximity" <> "\n") l
+traceGroupsProxi :: Map (PhyloGroupId,PhyloGroupId) Double -> Map (PhyloGroupId,PhyloGroupId) Double
+traceGroupsProxi m =
+    trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m

src/Gargantext/Core/Viz/Phylo/SynchronicClustering.hs

@@ -16,13 +16,13 @@ import Control.Lens hiding (Level)
 import Control.Monad (sequence)
 import Control.Parallel.Strategies (parList, rdeepseq, using)
 import Data.List ((++), null, intersect, nub, concat, sort, sortOn, groupBy)
-import Data.Map.Strict  (Map, fromList, fromListWith, foldlWithKey, (!), insert, empty, restrictKeys, elems, mapWithKey, member)
+import Data.Map  (Map, fromList, fromListWith, foldlWithKey, (!), insert, empty, restrictKeys, elems, mapWithKey, member)
 import Gargantext.Core.Viz.Phylo
 import Gargantext.Core.Viz.Phylo.PhyloExport (processDynamics)
 import Gargantext.Core.Viz.Phylo.PhyloTools
 import Gargantext.Core.Viz.Phylo.TemporalMatching (weightedLogJaccard', filterDiago, reduceDiagos)
 import Gargantext.Prelude
-import qualified Data.Map.Strict as Map
+import qualified Data.Map as Map
 
 
 -------------------------
@@ -159,7 +159,6 @@ reduceGroups prox sync docs diagos branch =
     let periods = fromListWith (++)
                  $ map (\g -> (g ^. phylo_groupPeriod,[g])) branch
     in  (concat . concat . elems)
-      -- TODO : ajouter un parallelisme
       $ mapWithKey (\prd groups -> 
             --  2) for each period, transform the groups as a proximity graph filtered by a threshold
             let diago = reduceDiagos $ filterDiago diagos [prd]
@@ -172,12 +171,12 @@ reduceGroups prox sync docs diagos branch =
               $ toRelatedComponents groups edges) periods 
 
 
-chooseClusteringStrategy :: Synchrony -> [[PhyloGroup]] -> [[PhyloGroup]]
-chooseClusteringStrategy sync branches = case sync of
+adjustClustering :: Synchrony -> [[PhyloGroup]] -> [[PhyloGroup]]
+adjustClustering sync branches = case sync of
   ByProximityThreshold _ _ scope _ -> case scope of 
       SingleBranch -> branches
-      SiblingBranches -> groupBy (\g g' -> (last' "chooseClusteringStrategy" $ (g  ^. phylo_groupMeta) ! "breaks")
-                                        == (last' "chooseClusteringStrategy" $ (g' ^. phylo_groupMeta) ! "breaks"))
+      SiblingBranches -> groupBy (\g g' -> (last' "adjustClustering" $ (g  ^. phylo_groupMeta) ! "breaks") 
+                                        == (last' "adjustClustering" $ (g' ^. phylo_groupMeta) ! "breaks"))
                        $ sortOn _phylo_groupBranchId $ concat branches
       AllBranches -> [concat branches]
   ByProximityDistribution _ _ -> branches
@@ -203,15 +202,15 @@ synchronicClustering phylo =
         diagos = map coocToDiago $ phylo ^. phylo_timeCooc
         newBranches  = map (\branch -> reduceGroups prox sync docs diagos branch) 
                      $ map processDynamics
-                     $ chooseClusteringStrategy sync
-                     $ phyloLastScale
+                     $ adjustClustering sync
+                     $ phyloToLastBranches 
                      $ traceSynchronyStart phylo
         newBranches' = newBranches `using` parList rdeepseq
      in toNextScale phylo $ levelUpAncestors $ concat newBranches'
 
 
--- synchronicSimilarity :: Phylo -> Level -> String
--- synchronicSimilarity phylo lvl =
+-- synchronicDistance :: Phylo -> Level -> String
+-- synchronicDistance phylo lvl = 
 --     foldl' (\acc branch -> 
 --              acc <> (foldl' (\acc' period ->
 --                               acc' <> let prox  = phyloProximity $ getConfig phylo