[DEBUG] Message
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / PhyloTools.hs
index d4b675cb0f4640e1d4a4ec152cc75122444c88a8..b1130b16f71977f2383f40ac30e47a55ded2d367 100644 (file)
@@ -12,28 +12,22 @@ Portability : POSIX
 
 module Gargantext.Core.Viz.Phylo.PhyloTools where
 
-import Data.Vector (Vector, elemIndex)
-import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, group)
+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.Set (Set, disjoint)
-import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
 import Data.String (String)
-import Data.Text (Text)
-
-import Prelude (floor)
-
+import Data.Text (Text,unpack)
+import Data.Vector (Vector, elemIndex)
+import Debug.Trace (trace)
+import Gargantext.Core.Viz.Phylo
 import Gargantext.Prelude
-import Gargantext.Core.Viz.AdaptativePhylo
+import Prelude (floor,read)
 import Text.Printf
-
-
-import Debug.Trace (trace)
-import Control.Lens hiding (Level)
-
-import qualified Data.Vector as Vector
 import qualified Data.List as List
 import qualified Data.Set as Set
-import qualified Data.Map as Map
 import qualified Data.Text as Text
+import qualified Data.Vector as Vector
 
 ------------
 -- | Io | --
@@ -41,9 +35,9 @@ import qualified Data.Text as Text
 
 -- | To print an important message as an IO()
 printIOMsg :: String -> IO ()
-printIOMsg msg = 
+printIOMsg msg =
     putStrLn ( "\n"
-            <> "------------" 
+            <> "------------"
             <> "\n"
             <> "-- | " <> msg <> "\n" )
 
@@ -64,13 +58,13 @@ printIOComment cmt =
 
 truncate' :: Double -> Int -> Double
 truncate' x n = (fromIntegral $ (floor (x * t) :: Int)) / t
-    where 
+    where
         --------------
         t :: Double
         t = 10 ^n
 
 getInMap :: Int -> Map Int Double -> Double
-getInMap k m = 
+getInMap k m =
     if (member k m)
         then m ! k
         else 0
@@ -115,6 +109,10 @@ isRoots n ns = Vector.elem n ns
 ngramsToIdx :: [Ngrams] -> Vector Ngrams -> [Int]
 ngramsToIdx ns fdt = map (\n -> fromJust $ elemIndex n fdt) ns
 
+-- | To transform a list of sources into a list of sources' index
+sourcesToIdx :: [Text] -> Vector Text -> [Int]
+sourcesToIdx ss ps = nub $ map (\s -> fromJust $ elemIndex s ps) ss
+
 -- | To transform a list of Ngrams Indexes into a Label
 ngramsToLabel :: Vector Ngrams -> [Int] -> Text
 ngramsToLabel ngrams l = Text.unwords $ tail' "ngramsToLabel" $ concat $ map (\n -> ["|",n]) $ ngramsToText ngrams l
@@ -141,36 +139,76 @@ periodsToYears periods = (Set.fromList . sort . concat)
 
 
 findBounds :: [Date] -> (Date,Date)
-findBounds dates = 
+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')
 
 
 toPeriods :: [Date] -> Int -> Int -> [(Date,Date)]
-toPeriods dates p s = 
+toPeriods dates p s =
     let (start,end) = findBounds dates
-    in map (\dates' -> (head' "toPeriods" dates', last' "toPeriods" dates')) 
+    in map (\dates' -> (head' "toPeriods" dates', last' "toPeriods" dates'))
      $ chunkAlong p s [start .. end]
 
 
+toFstDate :: [Text] -> Text
+toFstDate ds = snd
+             $ head' "firstDate"
+             $ sortOn fst
+             $ map (\d ->
+                      let d' = read (filter (\c -> notElem c ['U','T','C',' ',':','-']) $ unpack d)::Int
+                       in (d',d)) ds
+
+toLstDate :: [Text] -> Text
+toLstDate ds = snd
+             $ head' "firstDate"
+             $ reverse
+             $ sortOn fst
+             $ map (\d ->
+                      let d' = read (filter (\c -> notElem c ['U','T','C',' ',':','-']) $ unpack d)::Int
+                       in (d',d)) ds
+
+
+getTimeScale :: Phylo -> [Char]
+getTimeScale p = case (timeUnit $ getConfig p) of
+    Epoch _ _ _ -> "epoch"
+    Year  _ _ _ -> "year"
+    Month _ _ _ -> "month"
+    Week  _ _ _ -> "week"
+    Day   _ _ _ -> "day"
+
+
 -- | Get a regular & ascendante timeScale from a given list of dates
 toTimeScale :: [Date] -> Int -> [Date]
-toTimeScale dates step = 
+toTimeScale dates step =
     let (start,end) = findBounds dates
     in  [start, (start + step) .. end]
 
 
 getTimeStep :: TimeUnit -> Int
-getTimeStep time = case time of 
-    Year _ s _ -> s
+getTimeStep time = case time of
+    Epoch _ s _ -> s
+    Year  _ s _ -> s
+    Month _ s _ -> s
+    Week  _ s _ -> s
+    Day   _ s _ -> s
 
 getTimePeriod :: TimeUnit -> Int
-getTimePeriod time = case time of 
-    Year p _ _ -> p  
+getTimePeriod time = case time of
+    Epoch p _ _ -> p
+    Year  p _ _ -> p
+    Month p _ _ -> p
+    Week  p _ _ -> p
+    Day   p _ _ -> p
 
 getTimeFrame :: TimeUnit -> Int
-getTimeFrame time = case time of 
-    Year _ _ f -> f
+getTimeFrame time = case time of
+    Epoch _ _ f -> f
+    Year  _ _ f -> f
+    Month _ _ f -> f
+    Week  _ _ f -> f
+    Day   _ _ f -> f
 
 -------------
 -- | Fis | --
@@ -183,7 +221,7 @@ isNested l l'
   | null l'               = True
   | length l' > length l  = False
   | (union  l l') == l    = True
-  | otherwise             = False 
+  | otherwise             = False
 
 
 -- | To filter Fis with small Support but by keeping non empty Periods
@@ -193,42 +231,42 @@ keepFilled f thr l = if (null $ f thr l) && (not $ null l)
                      else f thr l
 
 
-traceClique :: Map (Date, Date) [PhyloClique] -> String
+traceClique :: Map (Date, Date) [Clustering] -> String
 traceClique mFis = foldl (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>" <> show (cpt) <> ") "  ) "" [1..6]
     where
         --------------------------------------
         cliques :: [Double]
-        cliques = sort $ map (fromIntegral . length . _phyloClique_nodes) $ concat $ elems mFis
-        -------------------------------------- 
+        cliques = sort $ map (fromIntegral . length . _clustering_roots) $ concat $ elems mFis
+        --------------------------------------
 
 
-traceSupport :: Map (Date, Date) [PhyloClique] -> String
+traceSupport :: Map (Date, Date) [Clustering] -> String
 traceSupport mFis = foldl (\msg cpt -> msg <> show (countSup cpt supports) <> " (>" <> show (cpt) <> ") "  ) "" [1..6]
     where
         --------------------------------------
         supports :: [Double]
-        supports = sort $ map (fromIntegral . _phyloClique_support) $ concat $ elems mFis
-        -------------------------------------- 
+        supports = sort $ map (fromIntegral . _clustering_support) $ concat $ elems mFis
+        --------------------------------------
 
 
-traceFis :: [Char] -> Map (Date, Date) [PhyloClique] -> Map (Date, Date) [PhyloClique]
+traceFis :: [Char] -> Map (Date, Date) [Clustering] -> Map (Date, Date) [Clustering]
 traceFis msg mFis = trace ( "\n" <> "-- | " <> msg <> " : " <> show (sum $ map length $ elems mFis) <> "\n"
                          <> "Support : " <> (traceSupport mFis) <> "\n"
                          <> "Nb Ngrams : "  <> (traceClique mFis)  <> "\n" ) mFis
 
 
----------------
--- | Clique| --
----------------
+----------------
+-- | Cluster| --
+----------------
 
 
-getCliqueSupport :: Clique -> Int
-getCliqueSupport unit = case unit of 
+getCliqueSupport :: Cluster -> Int
+getCliqueSupport unit = case unit of
     Fis s _ -> s
     MaxClique _ _ _ -> 0
 
-getCliqueSize :: Clique -> Int
-getCliqueSize unit = case unit of 
+getCliqueSize :: Cluster -> Int
+getCliqueSize unit = case unit of
     Fis _ s -> s
     MaxClique s _ _ -> s
 
@@ -258,7 +296,7 @@ listToSeq l = nubBy (\x y -> fst x == fst y) $ [ (x,y) | (x:rest) <- tails l,  y
 sumCooc :: Cooc -> Cooc -> Cooc
 sumCooc cooc cooc' = unionWith (+) cooc cooc'
 
-getTrace :: Cooc -> Double 
+getTrace :: Cooc -> Double
 getTrace cooc = sum $ elems $ filterWithKey (\(k,k') _ -> k == k') cooc
 
 coocToDiago :: Cooc -> Cooc
@@ -276,48 +314,68 @@ ngramsToCooc ngrams coocs =
 -- | PhyloGroup | --
 --------------------
 
-getGroupId :: PhyloGroup -> PhyloGroupId 
-getGroupId g = ((g ^. phylo_groupPeriod, g ^. phylo_groupLevel), g ^. phylo_groupIndex)
+getGroupId :: PhyloGroup -> PhyloGroupId
+getGroupId g = ((g ^. phylo_groupPeriod, g ^. phylo_groupScale), g ^. phylo_groupIndex)
 
-idToPrd :: PhyloGroupId -> PhyloPeriodId
+idToPrd :: PhyloGroupId -> Period
 idToPrd id = (fst . fst) id
 
 groupByField :: Ord a => (PhyloGroup -> a) -> [PhyloGroup] ->  Map a [PhyloGroup]
 groupByField toField groups = fromListWith (++) $ map (\g -> (toField g, [g])) groups
 
 getPeriodPointers :: Filiation -> PhyloGroup -> [Pointer]
-getPeriodPointers fil g = 
-    case fil of 
+getPeriodPointers fil g =
+    case fil of
         ToChilds  -> g ^. phylo_groupPeriodChilds
         ToParents -> g ^. phylo_groupPeriodParents
+        ToChildsMemory  -> undefined
+        ToParentsMemory -> undefined
 
 filterProximity :: Proximity -> Double -> Double -> Bool
-filterProximity proximity thr local = 
+filterProximity proximity thr local =
     case proximity of
-        WeightedLogJaccard _ -> local >= thr
-        WeightedLogSim _ -> local >= thr
-        Hamming -> undefined   
+        WeightedLogJaccard _ -> local >= thr
+        WeightedLogSim     _ _ -> local >= thr
+        Hamming            _ _ -> undefined
 
 getProximityName :: Proximity -> String
 getProximityName proximity =
     case proximity of
-        WeightedLogJaccard _ -> "WLJaccard"
-        WeightedLogSim _ -> "WeightedLogSim"
-        Hamming -> "Hamming"            
+        WeightedLogJaccard _ -> "WLJaccard"
+        WeightedLogSim     _ _ -> "WeightedLogSim"
+        Hamming            _ _ -> "Hamming"
 
 ---------------
 -- | Phylo | --
 ---------------
 
 addPointers :: Filiation -> PointerType -> [Pointer] -> PhyloGroup -> PhyloGroup
-addPointers fil pty pointers g = 
-    case pty of 
-        TemporalPointer -> case fil of 
+addPointers fil pty pointers g =
+    case pty of
+        TemporalPointer -> case fil of
                                 ToChilds  -> g & phylo_groupPeriodChilds  .~ pointers
                                 ToParents -> g & phylo_groupPeriodParents .~ pointers
-        LevelPointer    -> case fil of 
-                                ToChilds  -> g & phylo_groupLevelChilds   .~ pointers
-                                ToParents -> g & phylo_groupLevelParents  .~ pointers
+                                ToChildsMemory  -> undefined
+                                ToParentsMemory -> undefined
+        ScalePointer    -> case fil of
+                                ToChilds  -> g & phylo_groupScaleChilds   .~ pointers
+                                ToParents -> g & phylo_groupScaleParents  .~ pointers
+                                ToChildsMemory  -> undefined
+                                ToParentsMemory -> undefined
+
+toPointer' :: Double -> Pointer -> Pointer'
+toPointer' thr pt = (fst pt,(thr,snd pt))
+
+
+addMemoryPointers :: Filiation -> PointerType -> Double -> [Pointer] -> PhyloGroup -> PhyloGroup
+addMemoryPointers fil pty thr pointers g =
+    case pty of
+        TemporalPointer -> case fil of
+                                ToChilds  -> undefined
+                                ToParents -> undefined
+                                ToChildsMemory  -> g & phylo_groupPeriodMemoryChilds  .~ (concat [(g ^. phylo_groupPeriodMemoryChilds),(map (\pt -> toPointer' thr pt) pointers)])
+                                ToParentsMemory -> g & phylo_groupPeriodMemoryParents .~ (concat [(g ^. phylo_groupPeriodMemoryParents),(map (\pt -> toPointer' thr pt) pointers)])
+        ScalePointer    -> undefined
 
 
 getPeriodIds :: Phylo -> [(Date,Date)]
@@ -325,32 +383,43 @@ getPeriodIds phylo = sortOn fst
                    $ keys
                    $ phylo ^. phylo_periods
 
-getLevelParentId :: PhyloGroup -> PhyloGroupId 
-getLevelParentId g = fst $ head' "getLevelParentId" $ g ^. phylo_groupLevelParents
+getLevelParentId :: PhyloGroup -> PhyloGroupId
+getLevelParentId g = fst $ head' "getLevelParentId" $ g ^. phylo_groupScaleParents
 
-getLastLevel :: Phylo -> Level
-getLastLevel phylo = last' "lastLevel" $ getLevels phylo
+getLastLevel :: Phylo -> Scale
+getLastLevel phylo = last' "lastLevel" $ getScales phylo
 
-getLevels :: Phylo -> [Level]
-getLevels phylo = nub 
+getScales :: Phylo -> [Scale]
+getScales phylo = nub
                 $ map snd
                 $ keys $ view ( phylo_periods
                        .  traverse
-                       . phylo_periodLevels ) phylo
+                       . phylo_periodScales ) phylo
 
 getSeaElevation :: Phylo -> SeaElevation
 getSeaElevation phylo = seaElevation (getConfig phylo)
 
 
-getConfig :: Phylo -> Config
+getPhyloSeaRiseStart :: Phylo -> Double
+getPhyloSeaRiseStart phylo = case (getSeaElevation phylo) of
+    Constante  s _ -> s
+    Adaptative _ -> 0
+
+getPhyloSeaRiseSteps :: Phylo -> Double
+getPhyloSeaRiseSteps phylo = case (getSeaElevation phylo) of
+    Constante  _ s -> s
+    Adaptative s -> s
+
+
+getConfig :: Phylo -> PhyloConfig
 getConfig phylo = (phylo ^. phylo_param) ^. phyloParam_config
 
 
-setConfig :: Config -> Phylo -> Phylo
-setConfig config phylo = phylo 
-                       & phylo_param .~ (PhyloParam 
-                                            ((phylo ^. phylo_param) ^. phyloParam_version) 
-                                            ((phylo ^. phylo_param) ^. phyloParam_software) 
+setConfig :: PhyloConfig -> Phylo -> Phylo
+setConfig config phylo = phylo
+                       & phylo_param .~ (PhyloParam
+                                            ((phylo ^. phylo_param) ^. phyloParam_version)
+                                            ((phylo ^. phylo_param) ^. phyloParam_software)
                                             config)
 
 -- & phylo_param & phyloParam_config & phyloParam_config .~ config
@@ -359,64 +428,82 @@ setConfig config phylo = phylo
 getRoots :: Phylo -> Vector Ngrams
 getRoots phylo = (phylo ^. phylo_foundations) ^. foundations_roots
 
-phyloToLastBranches :: Phylo -> [[PhyloGroup]]
-phyloToLastBranches phylo = elems 
+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
     $ fromListWith (++)
     $ map (\g -> (g ^. phylo_groupBranchId, [g]))
-    $ getGroupsFromLevel (last' "byBranches" $ getLevels phylo) phylo
+    $ getGroupsFromScale (last' "byBranches" $ getScales phylo) phylo
 
-getGroupsFromLevel :: Level -> Phylo -> [PhyloGroup]
-getGroupsFromLevel lvl phylo = 
+getGroupsFromScale :: Scale -> Phylo -> [PhyloGroup]
+getGroupsFromScale lvl phylo =
     elems $ view ( phylo_periods
                  .  traverse
-                 . phylo_periodLevels
+                 . phylo_periodScales
                  .  traverse
-                 .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
-                 . phylo_levelGroups ) phylo
+                 .  filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == lvl)
+                 . phylo_scaleGroups ) phylo
 
 
-getGroupsFromLevelPeriods :: Level -> [PhyloPeriodId] -> Phylo -> [PhyloGroup]
-getGroupsFromLevelPeriods lvl periods phylo = 
+getGroupsFromScalePeriods :: Scale -> [Period] -> Phylo -> [PhyloGroup]
+getGroupsFromScalePeriods lvl periods phylo =
     elems $ view ( phylo_periods
                  .  traverse
                  .  filtered (\phyloPrd -> elem (phyloPrd ^. phylo_periodPeriod) periods)
-                 . phylo_periodLevels
+                 . phylo_periodScales
                  .  traverse
-                 .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
-                 . phylo_levelGroups ) phylo    
+                 .  filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == lvl)
+                 . phylo_scaleGroups ) phylo
 
 
-getGroupsFromPeriods :: Level -> Map PhyloPeriodId PhyloPeriod -> [PhyloGroup]
-getGroupsFromPeriods lvl periods = 
+getGroupsFromPeriods :: Scale -> Map Period PhyloPeriod -> [PhyloGroup]
+getGroupsFromPeriods lvl periods =
     elems $ view (  traverse
-                 . phylo_periodLevels
+                 . phylo_periodScales
                  .  traverse
-                 .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
-                 . phylo_levelGroups ) periods
+                 .  filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == lvl)
+                 . phylo_scaleGroups ) periods
 
 
-updatePhyloGroups :: Level -> Map PhyloGroupId PhyloGroup -> Phylo -> Phylo
-updatePhyloGroups lvl m phylo = 
+updatePhyloGroups :: Scale -> Map PhyloGroupId PhyloGroup -> Phylo -> Phylo
+updatePhyloGroups lvl m phylo =
     over ( phylo_periods
          .  traverse
-         . phylo_periodLevels
+         . phylo_periodScales
+         .  traverse
+         .  filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == lvl)
+         . phylo_scaleGroups
          .  traverse
-         .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
-         . phylo_levelGroups
-         .  traverse 
-         ) (\g -> 
+         ) (\g ->
                 let id = getGroupId g
-                in 
-                    if member id m 
+                in
+                    if member id m
                     then m ! id
                     else g ) phylo
 
+updatePeriods :: Map (Date,Date) (Text,Text) -> Phylo -> Phylo
+updatePeriods periods' phylo =
+    over (phylo_periods . traverse)
+            (\prd ->
+                let prd' = periods' ! (prd ^. phylo_periodPeriod)
+                    lvls = map (\lvl -> lvl & phylo_scalePeriodStr .~ prd') $ prd ^. phylo_periodScales
+                 in prd & phylo_periodPeriodStr .~ prd'
+                        & phylo_periodScales    .~ lvls
+                ) phylo
+
+updateQuality :: Double -> Phylo -> Phylo
+updateQuality quality phylo = phylo { _phylo_quality = quality }
+
 
-traceToPhylo :: Level -> Phylo -> Phylo
-traceToPhylo lvl phylo = 
+traceToPhylo :: Scale -> Phylo -> Phylo
+traceToPhylo lvl phylo =
     trace ("\n" <> "-- | End of phylo making at level " <> show (lvl) <> " with "
-                <> show (length $ getGroupsFromLevel lvl phylo) <> " groups and "
-                <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel lvl phylo) <> " branches" <> "\n") phylo 
+                <> show (length $ getGroupsFromScale lvl phylo) <> " groups and "
+                <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale lvl phylo) <> " branches" <> "\n") phylo
 
 --------------------
 -- | Clustering | --
@@ -427,28 +514,28 @@ mergeBranchIds ids = (head' "mergeBranchIds" . sort . mostFreq') ids
   where
     -- | 2) find the most Up Left ids in the hierarchy of similarity
     -- mostUpLeft :: [[Int]] -> [[Int]]
-    -- mostUpLeft ids' = 
+    -- mostUpLeft ids' =
     --      let groupIds = (map (\gIds -> (length $ head' "gIds" gIds, head' "gIds" gIds)) . groupBy (\id id' -> length id == length id') . sortOn length) ids'
     --          inf = (fst . minimum) groupIds
     --      in map snd $ filter (\gIds -> fst gIds == inf) groupIds
     -- | 1) find the most frequent ids
     mostFreq' :: [[Int]] -> [[Int]]
-    mostFreq' ids' = 
+    mostFreq' ids' =
        let groupIds = (map (\gIds -> (length gIds, head' "gIds" gIds)) . group . sort) ids'
            sup = (fst . maximum) groupIds
         in map snd $ filter (\gIds -> fst gIds == sup) groupIds
 
 
 mergeMeta :: [Int] -> [PhyloGroup] -> Map Text [Double]
-mergeMeta bId groups = 
-  let ego = head' "mergeMeta" $ filter (\g -> (snd (g ^. phylo_groupBranchId)) == bId) groups  
-   in fromList [("breaks",(ego ^. phylo_groupMeta) ! "breaks"),("seaLevels",(ego ^. phylo_groupMeta) ! "seaLevels")]   
+mergeMeta bId groups =
+  let ego = head' "mergeMeta" $ filter (\g -> (snd (g ^. phylo_groupBranchId)) == bId) groups
+   in fromList [("breaks",(ego ^. phylo_groupMeta) ! "breaks"),("seaLevels",(ego ^. phylo_groupMeta) ! "seaLevels")]
 
 
-groupsToBranches :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
-groupsToBranches groups =
+groupsToBranches' :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
+groupsToBranches' groups =
     {- run the related component algorithm -}
-    let egos  = map (\g -> [getGroupId g] 
+    let egos  = map (\g -> [getGroupId g]
                         ++ (map fst $ g ^. phylo_groupPeriodParents)
                         ++ (map fst $ g ^. phylo_groupPeriodChilds)
                         ++ (map fst $ g ^. phylo_groupAncestors)) $ elems groups
@@ -459,34 +546,36 @@ groupsToBranches groups =
             bId = mergeBranchIds $ map (\g -> snd $ g ^. phylo_groupBranchId) groups'
          in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph
 
+
 relatedComponents :: Ord a => [[a]] -> [[a]]
-relatedComponents graph = foldl' (\acc groups ->
-    if (null acc)
-    then acc ++ [groups]
-    else 
-        let acc' = partition (\groups' -> disjoint (Set.fromList groups') (Set.fromList groups)) acc
-         in (fst acc') ++ [nub $ concat $ (snd acc') ++ [groups]]) [] graph
+relatedComponents graph = foldl' (\branches groups ->
+    if (null branches)
+    then branches ++ [groups]
+    else
+        let branchPart = partition (\branch -> disjoint (Set.fromList branch) (Set.fromList groups)) branches
+         in (fst branchPart) ++ [nub $ concat $ (snd branchPart) ++ [groups]]) [] graph
+
 
 toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]
-toRelatedComponents nodes edges = 
+toRelatedComponents nodes edges =
   let ref = fromList $ map (\g -> (getGroupId g, g)) nodes
-      clusters = relatedComponents $ ((map (\((g,g'),_) -> [getGroupId g, getGroupId g']) edges) ++ (map (\g -> [getGroupId g]) nodes)) 
-   in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters 
+      clusters = relatedComponents $ ((map (\((g,g'),_) -> [getGroupId g, getGroupId g']) edges) ++ (map (\g -> [getGroupId g]) nodes))
+   in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters
 
 
 traceSynchronyEnd :: Phylo -> Phylo
-traceSynchronyEnd phylo = 
-    trace ( "-- | End synchronic clustering at level " <> show (getLastLevel phylo) 
-                 <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
-                 <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
+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"
                  <> "\n" ) phylo
 
 traceSynchronyStart :: Phylo -> Phylo
-traceSynchronyStart phylo = 
-    trace ( "\n" <> "-- | Start synchronic clustering at level " <> show (getLastLevel phylo) 
-                 <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
-                 <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
-                 <> "\n" ) 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"
+                 <> "\n" ) phylo
 
 
 -------------------
@@ -494,10 +583,16 @@ traceSynchronyStart phylo =
 -------------------
 
 getSensibility :: Proximity -> Double
-getSensibility proxi = case proxi of 
-    WeightedLogJaccard s -> s
-    WeightedLogSim s -> s
-    Hamming -> undefined
+getSensibility proxi = case proxi of
+    WeightedLogJaccard s _ -> s
+    WeightedLogSim     s _ -> s
+    Hamming            _ _ -> undefined
+
+getMinSharedNgrams :: Proximity -> Int
+getMinSharedNgrams proxi = case proxi of
+    WeightedLogJaccard _ m -> m
+    WeightedLogSim     _ m -> m
+    Hamming            _ _ -> undefined
 
 ----------------
 -- | Branch | --
@@ -552,7 +647,7 @@ traceMatchLimit branches =
                                            <> ",(1.." <> show (length branches) <> ")]"
                  <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
          <> " - unable to increase the threshold above 1" <> "\n"
-        ) branches            
+        ) branches
 
 
 traceMatchEnd :: [PhyloGroup] -> [PhyloGroup]
@@ -562,10 +657,10 @@ traceMatchEnd groups =
 
 
 traceTemporalMatching :: [PhyloGroup] -> [PhyloGroup]
-traceTemporalMatching groups = 
+traceTemporalMatching groups =
     trace ( "\n" <> "-- | Start temporal matching for " <> show(length groups) <> " groups" <> "\n") groups
 
 
-traceGroupsProxi :: Map (PhyloGroupId,PhyloGroupId) Double -> Map (PhyloGroupId,PhyloGroupId) Double
-traceGroupsProxi m = 
-    trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m
+traceGroupsProxi :: [Double] -> [Double]
+traceGroupsProxi l =
+    trace ( "\n" <> "-- | " <> show(List.length l) <> " computed pairs of groups proximity" <> "\n") l