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
  22 import Data.List        (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\))
  23 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys,insert)
  24 import Data.Maybe       (isNothing)
  25 import Data.Set         (Set)
  26 import Data.Text        (Text,unwords)
  27 import Data.Tuple       (fst, snd)
  28 import Data.Vector      (Vector)
  29
  30 import Gargantext.Prelude             hiding (head)
  31 import Gargantext.Viz.Phylo
  32 import Gargantext.Viz.Phylo.Tools
  33
  34 import qualified Data.List   as List
  35 import qualified Data.Map    as Map
  36 import qualified Data.Set    as Set
  37 import qualified Data.Vector as Vector
  38
  39
  40 -- | To add a new meta Metric to a PhyloBranch
  41 addBranchMetrics :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
  42 addBranchMetrics id lbl val v = over (phylo_viewBranches
  43                                      . traverse)
  44                                     (\b -> if getBranchId b == id
  45                                            then b & phylo_branchMetrics %~ insert lbl [val]
  46                                            else b) v
  47
  48
  49 -- | To get the age (in year) of all the branches of a PhyloView
  50 branchAge :: PhyloView -> PhyloView
  51 branchAge v = foldl (\v' b -> let bId = (fst . head) b
  52                                   prds = sortOn fst $ map snd b
  53                               in addBranchMetrics bId "age" ((abs . fromIntegral) $ ((snd . last) prds) - ((fst . head) prds)) v') v
  54             $ groupBy ((==) `on` fst)
  55             $ sortOn fst
  56             $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))
  57             $ getNodesInBranches v
  58
  59
  60 -- | To process a list of Metrics to a PhyloView
  61 processMetrics :: [Metric] -> Phylo -> PhyloView -> PhyloView
  62 processMetrics ms p v = foldl (\v' m -> case m of
  63                                         BranchAge -> branchAge v'
  64                                         _         -> panic "[ERR][Viz.Phylo.Example.processMetrics] metric not found") v ms
  65
  66