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

   1 {-|
   2 Module      : Gargantext.Core.Viz.Phylo.PhyloTools
   3 Description : Module dedicated to all the tools needed for making a Phylo
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 {-# LANGUAGE ViewPatterns      #-}
  12
  13 module Gargantext.Core.Viz.Phylo.PhyloTools where
  14
  15 import Data.Vector (Vector, elemIndex)
  16 import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, maximum, group)
  17 import Data.Set (Set, disjoint)
  18 import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
  19 import Data.String (String)
  20 import Data.Text (Text)
  21
  22 import Prelude (floor)
  23
  24 import Gargantext.Prelude
  25 import Gargantext.Core.Viz.AdaptativePhylo
  26 import Text.Printf
  27
  28
  29 import Debug.Trace (trace)
  30 import Control.Lens hiding (Level)
  31
  32 import qualified Data.Vector as Vector
  33 import qualified Data.List as List
  34 import qualified Data.Set as Set
  35 import qualified Data.Map as Map
  36 import qualified Data.Text as Text
  37
  38 ------------
  39 -- | Io | --
  40 ------------
  41
  42 -- | To print an important message as an IO()
  43 printIOMsg :: String -> IO ()
  44 printIOMsg msg =
  45     putStrLn ( "\n"
  46             <> "------------"
  47             <> "\n"
  48             <> "-- | " <> msg <> "\n" )
  49
  50
  51 -- | To print a comment as an IO()
  52 printIOComment :: String -> IO ()
  53 printIOComment cmt =
  54     putStrLn ( "\n" <> cmt <> "\n" )
  55
  56
  57 --------------
  58 -- | Misc | --
  59 --------------
  60
  61 -- truncate' :: Double -> Int -> Double
  62 -- truncate' x n = (fromIntegral (floor (x * t))) / t
  63 --     where t = 10^n
  64
  65 truncate' :: Double -> Int -> Double
  66 truncate' x n = (fromIntegral $ (floor (x * t) :: Int)) / t
  67     where
  68         --------------
  69         t :: Double
  70         t = 10 ^n
  71
  72 roundToStr :: (PrintfArg a, Floating a) => Int -> a -> String
  73 roundToStr = printf "%0.*f"
  74
  75
  76 countSup :: Double -> [Double] -> Int
  77 countSup s l = length $ filter (>s) l
  78
  79
  80 dropByIdx :: Int -> [a] -> [a]
  81 dropByIdx k l = take k l ++ drop (k+1) l
  82
  83
  84 elemIndex' :: Eq a => a -> [a] -> Int
  85 elemIndex' e l = case (List.elemIndex e l) of
  86     Nothing -> panic ("[ERR][Viz.Phylo.PhyloTools] element not in list")
  87     Just i  -> i
  88
  89
  90 commonPrefix :: Eq a => [a] -> [a] -> [a] -> [a]
  91 commonPrefix lst lst' acc =
  92     if (null lst || null lst')
  93         then acc
  94         else if (head' "commonPrefix" lst == head' "commonPrefix" lst')
  95                 then commonPrefix (tail lst) (tail lst') (acc ++ [head' "commonPrefix" lst])
  96                 else acc
  97
  98
  99 ---------------------
 100 -- | Foundations | --
 101 ---------------------
 102
 103
 104 -- | Is this Ngrams a Foundations Root ?
 105 isRoots :: Ngrams -> Vector Ngrams -> Bool
 106 isRoots n ns = Vector.elem n ns
 107
 108 -- | To transform a list of nrams into a list of foundation's index
 109 ngramsToIdx :: [Ngrams] -> Vector Ngrams -> [Int]
 110 ngramsToIdx ns fdt = map (\n -> fromJust $ elemIndex n fdt) ns
 111
 112 -- | To transform a list of Ngrams Indexes into a Label
 113 ngramsToLabel :: Vector Ngrams -> [Int] -> Text
 114 ngramsToLabel ngrams l = Text.unwords $ tail' "ngramsToLabel" $ concat $ map (\n -> ["|",n]) $ ngramsToText ngrams l
 115
 116 idxToLabel :: [Int] -> String
 117 idxToLabel l = List.unwords $ tail' "idxToLabel" $ concat $ map (\n -> ["|",show n]) l
 118
 119 idxToLabel' :: [Double] -> String
 120 idxToLabel' l = List.unwords $ tail' "idxToLabel" $ concat $ map (\n -> ["|",show n]) l
 121
 122 -- | To transform a list of Ngrams Indexes into a list of Text
 123 ngramsToText :: Vector Ngrams -> [Int] -> [Text]
 124 ngramsToText ngrams l = map (\idx -> ngrams Vector.! idx) l
 125
 126
 127 --------------
 128 -- | Time | --
 129 --------------
 130
 131 -- | To transform a list of periods into a set of Dates
 132 periodsToYears :: [(Date,Date)] -> Set Date
 133 periodsToYears periods = (Set.fromList . sort . concat)
 134                        $ map (\(d,d') -> [d..d']) periods
 135
 136
 137 findBounds :: [Date] -> (Date,Date)
 138 findBounds dates =
 139     let dates' = sort dates
 140     in  (head' "findBounds" dates', last' "findBounds" dates')
 141
 142
 143 toPeriods :: [Date] -> Int -> Int -> [(Date,Date)]
 144 toPeriods dates p s =
 145     let (start,end) = findBounds dates
 146     in map (\dates' -> (head' "toPeriods" dates', last' "toPeriods" dates'))
 147      $ chunkAlong p s [start .. end]
 148
 149
 150 -- | Get a regular & ascendante timeScale from a given list of dates
 151 toTimeScale :: [Date] -> Int -> [Date]
 152 toTimeScale dates step =
 153     let (start,end) = findBounds dates
 154     in  [start, (start + step) .. end]
 155
 156
 157 getTimeStep :: TimeUnit -> Int
 158 getTimeStep time = case time of
 159     Year _ s _ -> s
 160
 161 getTimePeriod :: TimeUnit -> Int
 162 getTimePeriod time = case time of
 163     Year p _ _ -> p
 164
 165 getTimeFrame :: TimeUnit -> Int
 166 getTimeFrame time = case time of
 167     Year _ _ f -> f
 168
 169 -------------
 170 -- | Fis | --
 171 -------------
 172
 173
 174 -- | To find if l' is nested in l
 175 isNested :: Eq a => [a] -> [a] -> Bool
 176 isNested l l'
 177   | null l'               = True
 178   | length l' > length l  = False
 179   | (union  l l') == l    = True
 180   | otherwise             = False
 181
 182
 183 -- | To filter Fis with small Support but by keeping non empty Periods
 184 keepFilled :: (Int -> [a] -> [a]) -> Int -> [a] -> [a]
 185 keepFilled f thr l = if (null $ f thr l) && (not $ null l)
 186                      then keepFilled f (thr - 1) l
 187                      else f thr l
 188
 189
 190 traceClique :: Map (Date, Date) [PhyloClique] -> String
 191 traceClique mFis = foldl (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>" <> show (cpt) <> ") "  ) "" [1..6]
 192     where
 193         --------------------------------------
 194         cliques :: [Double]
 195         cliques = sort $ map (fromIntegral . length . _phyloClique_nodes) $ concat $ elems mFis
 196         --------------------------------------
 197
 198
 199 traceSupport :: Map (Date, Date) [PhyloClique] -> String
 200 traceSupport mFis = foldl (\msg cpt -> msg <> show (countSup cpt supports) <> " (>" <> show (cpt) <> ") "  ) "" [1..6]
 201     where
 202         --------------------------------------
 203         supports :: [Double]
 204         supports = sort $ map (fromIntegral . _phyloClique_support) $ concat $ elems mFis
 205         --------------------------------------
 206
 207
 208 traceFis :: [Char] -> Map (Date, Date) [PhyloClique] -> Map (Date, Date) [PhyloClique]
 209 traceFis msg mFis = trace ( "\n" <> "-- | " <> msg <> " : " <> show (sum $ map length $ elems mFis) <> "\n"
 210                          <> "Support : " <> (traceSupport mFis) <> "\n"
 211                          <> "Nb Ngrams : "  <> (traceClique mFis)  <> "\n" ) mFis
 212
 213
 214 ---------------
 215 -- | Clique| --
 216 ---------------
 217
 218
 219 getCliqueSupport :: Clique -> Int
 220 getCliqueSupport unit = case unit of
 221     Fis s _ -> s
 222     MaxClique _ -> 0
 223
 224 getCliqueSize :: Clique -> Int
 225 getCliqueSize unit = case unit of
 226     Fis _ s -> s
 227     MaxClique s -> s
 228
 229
 230 --------------
 231 -- | Cooc | --
 232 --------------
 233
 234 listToCombi' :: [a] -> [(a,a)]
 235 listToCombi' l = [(x,y) | (x:rest) <- tails l,  y <- rest]
 236
 237 listToEqual' :: Eq a => [a] -> [(a,a)]
 238 listToEqual' l = [(x,y) | x <- l, y <- l, x == y]
 239
 240 listToKeys :: Eq a =>  [a] -> [(a,a)]
 241 listToKeys lst = (listToCombi' lst) ++ (listToEqual' lst)
 242
 243 listToMatrix :: [Int] -> Map (Int,Int) Double
 244 listToMatrix lst = fromList $ map (\k -> (k,1)) $ listToKeys $ sort lst
 245
 246 listToMatrix' :: [Ngrams] -> Map (Ngrams,Ngrams) Int
 247 listToMatrix' lst = fromList $ map (\k -> (k,1)) $ listToKeys $ sort lst
 248
 249 listToSeq :: Eq a =>  [a] -> [(a,a)]
 250 listToSeq l = nubBy (\x y -> fst x == fst y) $ [ (x,y) | (x:rest) <- tails l,  y <- rest ]
 251
 252 sumCooc :: Cooc -> Cooc -> Cooc
 253 sumCooc cooc cooc' = unionWith (+) cooc cooc'
 254
 255 getTrace :: Cooc -> Double
 256 getTrace cooc = sum $ elems $ filterWithKey (\(k,k') _ -> k == k') cooc
 257
 258 coocToDiago :: Cooc -> Cooc
 259 coocToDiago cooc = filterWithKey (\(k,k') _ -> k == k') cooc
 260
 261 -- | To build the local cooc matrix of each phylogroup
 262 ngramsToCooc :: [Int] -> [Cooc] -> Cooc
 263 ngramsToCooc ngrams coocs =
 264     let cooc  = foldl (\acc cooc' -> sumCooc acc cooc') empty coocs
 265         pairs = listToKeys ngrams
 266     in  filterWithKey (\k _ -> elem k pairs) cooc
 267
 268
 269 --------------------
 270 -- | PhyloGroup | --
 271 --------------------
 272
 273 getGroupId :: PhyloGroup -> PhyloGroupId
 274 getGroupId g = ((g ^. phylo_groupPeriod, g ^. phylo_groupLevel), g ^. phylo_groupIndex)
 275
 276 idToPrd :: PhyloGroupId -> PhyloPeriodId
 277 idToPrd id = (fst . fst) id
 278
 279 groupByField :: Ord a => (PhyloGroup -> a) -> [PhyloGroup] ->  Map a [PhyloGroup]
 280 groupByField toField groups = fromListWith (++) $ map (\g -> (toField g, [g])) groups
 281
 282 getPeriodPointers :: Filiation -> PhyloGroup -> [Pointer]
 283 getPeriodPointers fil g =
 284     case fil of
 285         ToChilds  -> g ^. phylo_groupPeriodChilds
 286         ToParents -> g ^. phylo_groupPeriodParents
 287
 288 filterProximity :: Proximity -> Double -> Double -> Bool
 289 filterProximity proximity thr local =
 290     case proximity of
 291         WeightedLogJaccard _ -> local >= thr
 292         Hamming -> undefined
 293
 294 getProximityName :: Proximity -> String
 295 getProximityName proximity =
 296     case proximity of
 297         WeightedLogJaccard _ -> "WLJaccard"
 298         Hamming -> "Hamming"
 299
 300 ---------------
 301 -- | Phylo | --
 302 ---------------
 303
 304 addPointers :: Filiation -> PointerType -> [Pointer] -> PhyloGroup -> PhyloGroup
 305 addPointers fil pty pointers g =
 306     case pty of
 307         TemporalPointer -> case fil of
 308                                 ToChilds  -> g & phylo_groupPeriodChilds  .~ pointers
 309                                 ToParents -> g & phylo_groupPeriodParents .~ pointers
 310         LevelPointer    -> case fil of
 311                                 ToChilds  -> g & phylo_groupLevelChilds   .~ pointers
 312                                 ToParents -> g & phylo_groupLevelParents  .~ pointers
 313
 314
 315 getPeriodIds :: Phylo -> [(Date,Date)]
 316 getPeriodIds phylo = sortOn fst
 317                    $ keys
 318                    $ phylo ^. phylo_periods
 319
 320 getLevelParentId :: PhyloGroup -> PhyloGroupId
 321 getLevelParentId g = fst $ head' "getLevelParentId" $ g ^. phylo_groupLevelParents
 322
 323 getLastLevel :: Phylo -> Level
 324 getLastLevel phylo = last' "lastLevel" $ getLevels phylo
 325
 326 getLevels :: Phylo -> [Level]
 327 getLevels phylo = nub
 328                 $ map snd
 329                 $ keys $ view ( phylo_periods
 330                        .  traverse
 331                        . phylo_periodLevels ) phylo
 332
 333 getSeaElevation :: Phylo -> SeaElevation
 334 getSeaElevation phylo = seaElevation (getConfig phylo)
 335
 336
 337 getConfig :: Phylo -> Config
 338 getConfig phylo = (phylo ^. phylo_param) ^. phyloParam_config
 339
 340
 341 getRoots :: Phylo -> Vector Ngrams
 342 getRoots phylo = (phylo ^. phylo_foundations) ^. foundations_roots
 343
 344 phyloToLastBranches :: Phylo -> [[PhyloGroup]]
 345 phyloToLastBranches phylo = elems
 346     $ fromListWith (++)
 347     $ map (\g -> (g ^. phylo_groupBranchId, [g]))
 348     $ getGroupsFromLevel (last' "byBranches" $ getLevels phylo) phylo
 349
 350 getGroupsFromLevel :: Level -> Phylo -> [PhyloGroup]
 351 getGroupsFromLevel lvl phylo =
 352     elems $ view ( phylo_periods
 353                  .  traverse
 354                  . phylo_periodLevels
 355                  .  traverse
 356                  .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
 357                  . phylo_levelGroups ) phylo
 358
 359
 360 getGroupsFromLevelPeriods :: Level -> [PhyloPeriodId] -> Phylo -> [PhyloGroup]
 361 getGroupsFromLevelPeriods lvl periods phylo =
 362     elems $ view ( phylo_periods
 363                  .  traverse
 364                  .  filtered (\phyloPrd -> elem (phyloPrd ^. phylo_periodPeriod) periods)
 365                  . phylo_periodLevels
 366                  .  traverse
 367                  .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
 368                  . phylo_levelGroups ) phylo
 369
 370
 371 getGroupsFromPeriods :: Level -> Map PhyloPeriodId PhyloPeriod -> [PhyloGroup]
 372 getGroupsFromPeriods lvl periods =
 373     elems $ view (  traverse
 374                  . phylo_periodLevels
 375                  .  traverse
 376                  .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
 377                  . phylo_levelGroups ) periods
 378
 379
 380 updatePhyloGroups :: Level -> Map PhyloGroupId PhyloGroup -> Phylo -> Phylo
 381 updatePhyloGroups lvl m phylo =
 382     over ( phylo_periods
 383          .  traverse
 384          . phylo_periodLevels
 385          .  traverse
 386          .  filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
 387          . phylo_levelGroups
 388          .  traverse
 389          ) (\g ->
 390                 let id = getGroupId g
 391                 in
 392                     if member id m
 393                     then m ! id
 394                     else g ) phylo
 395
 396
 397 traceToPhylo :: Level -> Phylo -> Phylo
 398 traceToPhylo lvl phylo =
 399     trace ("\n" <> "-- | End of phylo making at level " <> show (lvl) <> " with "
 400                 <> show (length $ getGroupsFromLevel lvl phylo) <> " groups and "
 401                 <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel lvl phylo) <> " branches" <> "\n") phylo
 402
 403 --------------------
 404 -- | Clustering | --
 405 --------------------
 406
 407 mergeBranchIds :: [[Int]] -> [Int]
 408 mergeBranchIds ids = (head' "mergeBranchIds" . sort . mostFreq') ids
 409   where
 410     -- | 2) find the most Up Left ids in the hierarchy of similarity
 411     -- mostUpLeft :: [[Int]] -> [[Int]]
 412     -- mostUpLeft ids' =
 413     --      let groupIds = (map (\gIds -> (length $ head' "gIds" gIds, head' "gIds" gIds)) . groupBy (\id id' -> length id == length id') . sortOn length) ids'
 414     --          inf = (fst . minimum) groupIds
 415     --      in map snd $ filter (\gIds -> fst gIds == inf) groupIds
 416     -- | 1) find the most frequent ids
 417     mostFreq' :: [[Int]] -> [[Int]]
 418     mostFreq' ids' =
 419        let groupIds = (map (\gIds -> (length gIds, head' "gIds" gIds)) . group . sort) ids'
 420            sup = (fst . maximum) groupIds
 421         in map snd $ filter (\gIds -> fst gIds == sup) groupIds
 422
 423
 424 mergeMeta :: [Int] -> [PhyloGroup] -> Map Text [Double]
 425 mergeMeta bId groups =
 426   let ego = head' "mergeMeta" $ filter (\g -> (snd (g ^. phylo_groupBranchId)) == bId) groups
 427    in fromList [("breaks",(ego ^. phylo_groupMeta) ! "breaks"),("seaLevels",(ego ^. phylo_groupMeta) ! "seaLevels")]
 428
 429
 430 groupsToBranches :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
 431 groupsToBranches groups =
 432     -- | run the related component algorithm
 433     let egos  = map (\g -> [getGroupId g]
 434                         ++ (map fst $ g ^. phylo_groupPeriodParents)
 435                         ++ (map fst $ g ^. phylo_groupPeriodChilds)
 436                         ++ (map fst $ g ^. phylo_groupAncestors)) $ elems groups
 437         graph = relatedComponents egos
 438     -- | update each group's branch id
 439     in map (\ids ->
 440         let groups' = elems $ restrictKeys groups (Set.fromList ids)
 441             bId = mergeBranchIds $ map (\g -> snd $ g ^. phylo_groupBranchId) groups'
 442          in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph
 443
 444 relatedComponents :: Ord a => [[a]] -> [[a]]
 445 relatedComponents graph = foldl' (\acc groups ->
 446     if (null acc)
 447     then acc ++ [groups]
 448     else
 449         let acc' = partition (\groups' -> disjoint (Set.fromList groups') (Set.fromList groups)) acc
 450          in (fst acc') ++ [nub $ concat $ (snd acc') ++ [groups]]) [] graph
 451
 452 toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]
 453 toRelatedComponents nodes edges =
 454   let ref = fromList $ map (\g -> (getGroupId g, g)) nodes
 455       clusters = relatedComponents $ ((map (\((g,g'),_) -> [getGroupId g, getGroupId g']) edges) ++ (map (\g -> [getGroupId g]) nodes))
 456    in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters
 457
 458
 459 traceSynchronyEnd :: Phylo -> Phylo
 460 traceSynchronyEnd phylo =
 461     trace ( "\n" <> "-- | End synchronic clustering at level " <> show (getLastLevel phylo)
 462                  <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
 463                  <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
 464                  <> "\n" ) phylo
 465
 466 traceSynchronyStart :: Phylo -> Phylo
 467 traceSynchronyStart phylo =
 468     trace ( "\n" <> "-- | Start synchronic clustering at level " <> show (getLastLevel phylo)
 469                  <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
 470                  <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
 471                  <> "\n" ) phylo
 472
 473
 474 -------------------
 475 -- | Proximity | --
 476 -------------------
 477
 478 getSensibility :: Proximity -> Double
 479 getSensibility proxi = case proxi of
 480     WeightedLogJaccard s -> s
 481     Hamming -> undefined
 482
 483 ----------------
 484 -- | Branch | --
 485 ----------------
 486
 487 intersectInit :: Eq a => [a] -> [a] -> [a] -> [a]
 488 intersectInit acc lst lst' =
 489     if (null lst) || (null lst')
 490     then acc
 491     else if (head' "intersectInit" lst) == (head' "intersectInit" lst')
 492          then intersectInit (acc ++ [head' "intersectInit" lst]) (tail lst) (tail lst')
 493          else acc
 494
 495 branchIdsToProximity :: PhyloBranchId -> PhyloBranchId -> Double -> Double -> Double
 496 branchIdsToProximity id id' thrInit thrStep = thrInit + thrStep * (fromIntegral $ length $ intersectInit [] (snd id) (snd id'))
 497
 498 ngramsInBranches :: [[PhyloGroup]] -> [Int]
 499 ngramsInBranches branches = nub $ foldl (\acc g -> acc ++ (g ^. phylo_groupNgrams)) [] $ concat branches
 500
 501
 502 traceMatchSuccess :: Double -> Double -> Double -> [[[PhyloGroup]]] -> [[[PhyloGroup]]]
 503 traceMatchSuccess thr qua qua' nextBranches =
 504     trace ( "\n" <> "-- local branches : " <> (init $ show ((init . init . snd)
 505                                                     $ (head' "trace" $ head' "trace" $ head' "trace" nextBranches) ^. phylo_groupBranchId))
 506                                            <> ",(1.." <> show (length nextBranches) <> ")]"
 507                  <> " | " <> show ((length . concat . concat) nextBranches) <> " groups" <> "\n"
 508          <> " - splited with success in "  <> show (map length nextBranches) <> " sub-branches" <> "\n"
 509          <> " - for the local threshold "  <> show (thr) <> " ( quality : " <> show (qua) <> " < " <> show(qua') <> ")\n" ) nextBranches
 510
 511
 512 traceMatchFailure :: Double -> Double -> Double -> [[PhyloGroup]] -> [[PhyloGroup]]
 513 traceMatchFailure thr qua qua' branches =
 514     trace ( "\n" <> "-- local branches : " <> (init $ show ((init . snd) $ (head' "trace" $ head' "trace" branches) ^. phylo_groupBranchId))
 515                                            <> ",(1.." <> show (length branches) <> ")]"
 516                  <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
 517          <> " - split with failure for the local threshold " <> show (thr) <> " ( quality : " <> show (qua) <> " > " <> show(qua') <> ")\n"
 518         ) branches
 519
 520
 521 traceMatchNoSplit :: [[PhyloGroup]] -> [[PhyloGroup]]
 522 traceMatchNoSplit branches =
 523     trace ( "\n" <> "-- local branches : " <> (init $ show ((init . snd) $ (head' "trace" $ head' "trace" branches) ^. phylo_groupBranchId))
 524                                            <> ",(1.." <> show (length branches) <> ")]"
 525                  <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
 526          <> " - unable to split in smaller branches" <> "\n"
 527         ) branches
 528
 529
 530 traceMatchLimit :: [[PhyloGroup]] -> [[PhyloGroup]]
 531 traceMatchLimit branches =
 532     trace ( "\n" <> "-- local branches : " <> (init $ show ((init . snd) $ (head' "trace" $ head' "trace" branches) ^. phylo_groupBranchId))
 533                                            <> ",(1.." <> show (length branches) <> ")]"
 534                  <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
 535          <> " - unable to increase the threshold above 1" <> "\n"
 536         ) branches
 537
 538
 539 traceMatchEnd :: [PhyloGroup] -> [PhyloGroup]
 540 traceMatchEnd groups =
 541     trace ("\n" <> "-- | End temporal matching with " <> show (length $ nub $ map (\g -> g ^. phylo_groupBranchId) groups)
 542                                                          <> " branches and " <> show (length groups) <> " groups" <> "\n") groups
 543
 544
 545 traceTemporalMatching :: [PhyloGroup] -> [PhyloGroup]
 546 traceTemporalMatching groups =
 547     trace ( "\n" <> "-- | Start temporal matching for " <> show(length groups) <> " groups" <> "\n") groups
 548
 549
 550 traceGroupsProxi :: Map (PhyloGroupId,PhyloGroupId) Double -> Map (PhyloGroupId,PhyloGroupId) Double
 551 traceGroupsProxi m =
 552     trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m