src/Gargantext/Core/Viz/Phylo/View/Metrics.hs

   1 {-|
   2 Module      : Gargantext.Core.Viz.Phylo.Tools
   3 Description : Phylomemy Tools to build/manage it
   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 -}
  12
  13
  14 module Gargantext.Core.Viz.Phylo.View.Metrics
  15   where
  16
  17 import Control.Lens     hiding (makeLenses, both, Level)
  18 import Data.List        (last,groupBy,sortOn)
  19 import Data.Map         (insert)
  20 import Data.Text        (Text)
  21 import Data.Tuple       (fst, snd)
  22 import Gargantext.Prelude
  23 import Gargantext.Core.Viz.Phylo
  24 import Gargantext.Core.Viz.Phylo.Tools
  25
  26
  27 -- | To add a new meta Metric to a PhyloBranch
  28 addBranchMetrics :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
  29 addBranchMetrics id lbl val v = over (pv_branches
  30                                      . traverse)
  31                                     (\b -> if getBranchId b == id
  32                                            then b & pb_metrics %~ insert lbl [val]
  33                                            else b) v
  34
  35
  36 branchGroups :: PhyloView -> PhyloView
  37 branchGroups v = foldl (\v' (bId,nb) -> addBranchMetrics bId "nbGroups" nb v') v
  38                $ map (\(bId,ns) -> (bId,fromIntegral $ length ns))
  39                $ getNodesByBranches v
  40
  41
  42 -- | To get the age (in year) of all the branches of a PhyloView
  43 branchAge :: PhyloView -> PhyloView
  44 branchAge v = foldl (\v' b -> let bId = (fst . (head' "branchAge")) b
  45                                   prds = sortOn fst $ map snd b
  46                               in addBranchMetrics bId "age" ((abs . fromIntegral) $ ((snd . last) prds) - (fst $ head' "branchAge" prds)) v') v
  47             $ groupBy ((==) `on` fst)
  48             $ sortOn fst
  49             $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))
  50             $ getNodesInBranches v
  51
  52
  53 -- | To get the age (in year) of all the branches of a PhyloView
  54 branchBirth :: PhyloView -> PhyloView
  55 branchBirth v = foldl (\v' b -> let bId = (fst . (head' "branchBirth")) b
  56                                     prds = sortOn fst $ map snd b
  57                               in addBranchMetrics bId "birth" (fromIntegral $ fst $ head' "branchAge" prds) v') v
  58             $ groupBy ((==) `on` fst)
  59             $ sortOn fst
  60             $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))
  61             $ getNodesInBranches v
  62
  63
  64 -- | To process a list of Metrics to a PhyloView
  65 processMetrics :: [Metric] -> Phylo -> PhyloView -> PhyloView
  66 processMetrics ms _p v = foldl (\v' m -> case m of
  67                                         BranchAge -> branchAge v'
  68                                         BranchBirth -> branchBirth v'
  69                                         BranchGroups -> branchGroups v'
  70                                        -- _         -> panic "[ERR][Viz.Phylo.Example.processMetrics] metric not found"
  71                                         ) v ms
  72
  73