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
13 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE OverloadedStrings #-}
17 module Gargantext.Viz.Phylo.BranchMaker
20 import Control.Lens hiding (both, Level)
22 import Data.List (last,head,union,concat,null,nub,(++),init,tail,(!!))
23 import Data.Map (Map,elems,adjust,unionWith,intersectionWith)
25 import Data.Tuple (fst, snd)
27 import Gargantext.Prelude hiding (head)
28 import Gargantext.Viz.Phylo
29 import Gargantext.Viz.Phylo.Tools
30 import Gargantext.Viz.Phylo.Metrics.Proximity
31 import Gargantext.Viz.Phylo.Metrics.Clustering
33 import qualified Data.List as List
34 import qualified Data.Map as Map
35 import qualified Data.Set as Set
38 -- | To transform a PhyloGraph into a list of PhyloBranches by using the relatedComp clustering
39 graphToBranches :: Level -> GroupGraph -> Phylo -> [(Int,PhyloGroupId)]
40 graphToBranches lvl (nodes,edges) p = concat
41 $ map (\(idx,gs) -> map (\g -> (idx,getGroupId g)) gs)
43 $ relatedComp 0 (head nodes) (tail nodes,edges) [] []
46 -- | To transform a list of PhyloGroups into a PhyloGraph by using a given Proximity mesure
47 groupsToGraph :: (Proximity,[Double]) -> [PhyloGroup] -> Phylo -> GroupGraph
48 groupsToGraph (prox,param) groups p = (groups,edges)
52 FromPairs -> (nub . concat) $ map (\g -> (map (\g' -> ((g',g),1)) $ getGroupParents g p)
54 (map (\g' -> ((g,g'),1)) $ getGroupChilds g p)) groups
55 WeightedLogJaccard -> filter (\edge -> snd edge >= (param !! 0))
56 $ map (\(x,y) -> ((x,y), weightedLogJaccard
57 (param !! 1) (getGroupCooc x)
58 (unifySharedKeys (getGroupCooc x) (getGroupCooc y)))) $ listToDirectedCombi groups
59 Hamming -> filter (\edge -> snd edge <= (param !! 0))
60 $ map (\(x,y) -> ((x,y), hamming (getGroupCooc x)
61 (unifySharedKeys (getGroupCooc x) (getGroupCooc y)))) $ listToDirectedCombi groups
65 -- | To set all the PhyloBranches for a given Level in a Phylo
66 setPhyloBranches :: Level -> Phylo -> Phylo
67 setPhyloBranches lvl p = alterGroupWithLevel (\g -> let bIdx = (fst . head) $ filter (\b -> snd b == getGroupId g) bs
68 in over (phylo_groupBranchId) (\x -> Just (lvl,bIdx)) g) lvl p
70 --------------------------------------
71 bs :: [(Int,PhyloGroupId)]
72 bs = graphToBranches lvl graph p
73 --------------------------------------
75 graph = groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p
76 --------------------------------------