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