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)
  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 -> PhyloGraph -> 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,[Double]) -> [PhyloGroup] -> Phylo -> PhyloGraph
  48 groupsToGraph (prox,param) groups p = (groups,edges)
  49   where
  50     edges :: PhyloEdges
  51     edges = case prox of
  52       FromPairs          -> (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 -> 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
  62       _                  -> undefined
  63
  64
  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
  69   where
  70     --------------------------------------
  71     bs :: [(Int,PhyloGroupId)]
  72     bs = graphToBranches lvl graph p
  73     --------------------------------------
  74     graph :: PhyloGraph
  75     graph = groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p
  76     --------------------------------------