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

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