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
14 module Gargantext.Core.Viz.Phylo.View.Metrics
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 Gargantext.Prelude
22 import Gargantext.Core.Viz.Phylo
23 import Gargantext.Core.Viz.Phylo.Tools
26 -- | To add a new meta Metric to a PhyloBranch
27 addBranchMetrics :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
28 addBranchMetrics id lbl val v = over (pv_branches
30 (\b -> if getBranchId b == id
31 then b & pb_metrics %~ insert lbl [val]
35 branchGroups :: PhyloView -> PhyloView
36 branchGroups v = foldl (\v' (bId,nb) -> addBranchMetrics bId "nbGroups" nb v') v
37 $ map (\(bId,ns) -> (bId,fromIntegral $ length ns))
38 $ getNodesByBranches v
41 -- | To get the age (in year) of all the branches of a PhyloView
42 branchAge :: PhyloView -> PhyloView
43 branchAge v = foldl (\v' b -> let bId = (fst . (head' "branchAge")) b
44 prds = sortOn fst $ map snd b
45 in addBranchMetrics bId "age" ((abs . fromIntegral) $ ((snd . last) prds) - (fst $ head' "branchAge" prds)) v') v
46 $ groupBy ((==) `on` fst)
48 $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))
49 $ getNodesInBranches v
52 -- | To get the age (in year) of all the branches of a PhyloView
53 branchBirth :: PhyloView -> PhyloView
54 branchBirth v = foldl (\v' b -> let bId = (fst . (head' "branchBirth")) b
55 prds = sortOn fst $ map snd b
56 in addBranchMetrics bId "birth" (fromIntegral $ fst $ head' "branchAge" prds) v') v
57 $ groupBy ((==) `on` fst)
59 $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))
60 $ getNodesInBranches v
63 -- | To process a list of Metrics to a PhyloView
64 processMetrics :: [Metric] -> Phylo -> PhyloView -> PhyloView
65 processMetrics ms _p v = foldl (\v' m -> case m of
66 BranchAge -> branchAge v'
67 BranchBirth -> branchBirth v'
68 BranchGroups -> branchGroups v'
69 -- _ -> panic "[ERR][Viz.Phylo.Example.processMetrics] metric not found"