src/Gargantext/Viz/Phylo/BranchMaker.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.BranchMaker
  18   where
  19
  20 import Control.Lens     hiding (both, Level)
  21
  22 import Data.List        (last,head,union,concat,null,nub,(++),init,tail,(!!))
  23 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,empty,(!))
  24 import Data.Set         (Set)
  25 import Data.Tuple       (fst, snd)
  26
  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
  32
  33 import qualified Data.List   as List
  34 import qualified Data.Map    as Map
  35 import qualified Data.Set    as Set
  36
  37
  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)
  42                                     $ zip [1..]
  43                                     $ relatedComp 0 (head nodes) (tail nodes,edges) [] []
  44
  45
  46 -- | To transform a list of PhyloGroups into a PhyloGraph by using a given Proximity mesure
  47 groupsToGraph :: Proximity -> [PhyloGroup] -> Phylo -> GroupGraph
  48 groupsToGraph prox groups p = (groups,edges)
  49   where
  50     edges :: GroupEdges
  51     edges = case prox of
  52       Filiation          -> (nub . concat) $ map (\g -> (map (\g' -> ((g',g),1)) $ getGroupParents g p)
  53                                                         ++
  54                                                         (map (\g' -> ((g,g'),1)) $ getGroupChilds g p)) groups
  55       WeightedLogJaccard (WLJParams thr sens) -> filter (\edge -> snd edge >= thr)
  56                                                $ map (\(x,y) -> ((x,y), weightedLogJaccard sens (getGroupCooc x) (unifySharedKeys (getGroupCooc x) (getGroupCooc y))))
  57                                                $ listToDirectedCombi groups
  58       Hamming (HammingParams thr) -> filter (\edge -> snd edge <= thr)
  59                                    $ map (\(x,y) -> ((x,y), hamming (getGroupCooc x) (unifySharedKeys (getGroupCooc x) (getGroupCooc y))))
  60                                    $ listToDirectedCombi groups
  61       _                  -> undefined
  62
  63
  64 -- | To set all the PhyloBranches for a given Level in a Phylo
  65 setPhyloBranches :: Level -> Phylo -> Phylo
  66 setPhyloBranches lvl p = alterGroupWithLevel (\g -> let bIdx = (fst . head) $ filter (\b -> snd b == getGroupId g) bs
  67                                                      in over (phylo_groupBranchId) (\x -> Just (lvl,bIdx)) g) lvl p
  68   where
  69     --------------------------------------
  70     bs :: [(Int,PhyloGroupId)]
  71     bs = graphToBranches lvl graph p
  72     --------------------------------------
  73     graph :: GroupGraph
  74     graph = groupsToGraph Filiation (getGroupsWithLevel lvl p) p
  75     --------------------------------------