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 -> map (\(x,y) -> ((x,y), weightedLogJaccard
  53                                                    (param !! 0) (getGroupCooc x)
  54                                                    (unifySharedKeys (getGroupCooc x) (getGroupCooc y)))) $ listToDirectedCombi groups
  55       _                  -> undefined
  56
  57
  58 -- | To set all the PhyloBranches for a given Level in a Phylo
  59 setPhyloBranches :: Level -> Phylo -> Phylo
  60 setPhyloBranches lvl p = alterPhyloBranches (\l -> l ++ (graphToBranches lvl (groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p) p) ) p