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 Data.List        (last,head,union,concat,null,nub,(++),init,tail,(!!))
  21 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith)
  22 import Data.Set         (Set)
  23 import Data.Tuple       (fst, snd)
  24
  25 import Gargantext.Prelude             hiding (head)
  26 import Gargantext.Viz.Phylo
  27 import Gargantext.Viz.Phylo.Tools
  28 import Gargantext.Viz.Phylo.Metrics.Proximity
  29 import Gargantext.Viz.Phylo.Metrics.Clustering
  30
  31 import qualified Data.List   as List
  32 import qualified Data.Map    as Map
  33 import qualified Data.Set    as Set
  34
  35
  36 -- | To transform a PhyloGraph into a list of PhyloBranches by using the relatedComp clustering
  37 graphToBranches :: Level -> PhyloGraph -> Phylo -> [PhyloBranch]
  38 graphToBranches lvl (nodes,edges) p = map (\(idx,c) -> PhyloBranch (lvl,idx) "" (map getGroupId c))
  39                                     $ zip [0..]
  40                                     $ relatedComp 0 (head nodes) (tail nodes,edges) [] []
  41
  42
  43 -- | To transform a list of PhyloGroups into a PhyloGraph by using a given Proximity mesure
  44 groupsToGraph :: (Proximity,[Double]) -> [PhyloGroup] -> Phylo -> PhyloGraph
  45 groupsToGraph (prox,param) groups p = (groups,edges)
  46   where
  47     edges :: PhyloEdges
  48     edges = case prox of
  49       FromPairs          -> (nub . concat) $ map (\g -> (map (\g' -> ((g',g),1)) $ getGroupParents g p)
  50                                                         ++
  51                                                         (map (\g' -> ((g,g'),1)) $ getGroupChilds g p)) groups
  52       WeightedLogJaccard -> filter (\edge -> snd edge >= (param !! 0))
  53                           $ map (\(x,y) -> ((x,y), weightedLogJaccard
  54                                 (param !! 1) (getGroupCooc x)
  55                                 (unifySharedKeys (getGroupCooc x) (getGroupCooc y)))) $ listToDirectedCombi groups
  56       Hamming            -> filter (\edge -> snd edge <= (param !! 0))
  57                           $ map (\(x,y) -> ((x,y), hamming (getGroupCooc x)
  58                                 (unifySharedKeys (getGroupCooc x) (getGroupCooc y)))) $ listToDirectedCombi groups
  59       _                  -> undefined
  60
  61
  62 -- | To set all the PhyloBranches for a given Level in a Phylo
  63 setPhyloBranches :: Level -> Phylo -> Phylo
  64 setPhyloBranches lvl p = alterPhyloBranches (\l -> l ++ (graphToBranches lvl (groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p) p) ) p