src/Gargantext/Viz/Phylo/View/ViewMaker.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.View.ViewMaker
  18   where
  19
  20 import Control.Lens     hiding (makeLenses, both, Level)
  21
  22 import Data.List        (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\))
  23 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys,insert,empty)
  24 import Data.Maybe       (isNothing)
  25 import Data.Set         (Set)
  26 import Data.Text        (Text,unwords)
  27 import Data.Tuple       (fst, snd)
  28 import Data.Vector      (Vector)
  29
  30 import Gargantext.Prelude             hiding (head)
  31 import Gargantext.Viz.Phylo
  32 import Gargantext.Viz.Phylo.Tools
  33 import Gargantext.Viz.Phylo.View.Display
  34 import Gargantext.Viz.Phylo.View.Filters
  35 import Gargantext.Viz.Phylo.View.Metrics
  36 import Gargantext.Viz.Phylo.View.Sort
  37 import Gargantext.Viz.Phylo.View.Taggers
  38
  39 import qualified Data.List   as List
  40 import qualified Data.Map    as Map
  41 import qualified Data.Set    as Set
  42 import qualified Data.Vector as Vector
  43
  44
  45 -- | To init a PhyloBranch
  46 initPhyloBranch :: PhyloBranchId -> Text -> PhyloBranch
  47 initPhyloBranch id lbl = PhyloBranch id lbl empty
  48
  49
  50 -- | To init a PhyloEdge
  51 initPhyloEdge :: PhyloGroupId -> [Pointer] -> EdgeType -> [PhyloEdge]
  52 initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
  53
  54
  55 -- | To init a PhyloView
  56 initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView
  57 initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl empty
  58                                     ([] ++ (phyloToBranches lvl p))
  59                                     ([] ++ (groupsToNodes True vb (getFoundations p) gs))
  60                                     ([] ++ (groupsToEdges fl PeriodEdge gs))
  61   where
  62     --------------------------------------
  63     gs :: [PhyloGroup]
  64     gs = getGroupsWithLevel lvl p
  65     --------------------------------------
  66
  67
  68 -- | To transform a list of PhyloGroups into a list of PhyloNodes
  69 groupsToNodes :: Bool -> Bool -> Vector Ngrams -> [PhyloGroup] -> [PhyloNode]
  70 groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
  71                                          in PhyloNode
  72                                               (getGroupId g)
  73                                               (getGroupBranchId g)
  74                                               "" idxs
  75                                               (if isV
  76                                                 then Just (ngramsToText ns idxs)
  77                                                 else Nothing)
  78                                               empty
  79                                               (if (not isR)
  80                                                 then Just (head $ getGroupLevelParentsId g)
  81                                                 else Nothing)
  82                                               []
  83                                   ) gs
  84
  85
  86 -- | To transform a list of PhyloGroups into a list of PhyloEdges
  87 groupsToEdges :: Filiation -> EdgeType -> [PhyloGroup] -> [PhyloEdge]
  88 groupsToEdges fl et gs = case fl of
  89                          Complete -> (groupsToEdges Ascendant et gs) ++ (groupsToEdges Descendant et gs)
  90                          _        -> concat
  91                                    $ map (\g -> case fl of
  92                                                 Ascendant  -> case et of
  93                                                               PeriodEdge -> initPhyloEdge (getGroupId g) (getGroupPeriodParents g) et
  94                                                               LevelEdge  -> initPhyloEdge (getGroupId g) (getGroupLevelParents  g) et
  95                                                 Descendant -> case et of
  96                                                               PeriodEdge -> initPhyloEdge (getGroupId g) (getGroupPeriodChilds  g) et
  97                                                               LevelEdge  -> initPhyloEdge (getGroupId g) (getGroupLevelChilds   g) et
  98                                                 ) gs
  99
 100
 101 -- | To transform a Phylo into a list of PhyloBranch for a given Level
 102 phyloToBranches :: Level -> Phylo -> [PhyloBranch]
 103 phyloToBranches lvl p = map (\id -> initPhyloBranch id "") $ nub $ getBranchIdsWith lvl p
 104
 105
 106 -- | To add recursively a list of PhyloNodes and Edges to PhyloView from a given Level and Depth
 107 addChildNodes :: Bool -> Level -> Level -> Bool -> Filiation -> Phylo -> PhyloView -> PhyloView
 108 addChildNodes shouldDo lvl lvlMin vb fl p v =
 109   if (not shouldDo) || (lvl == lvlMin)
 110   then v
 111   else addChildNodes shouldDo (lvl - 1) lvlMin vb fl p
 112      $ v & phylo_viewBranches %~ (++ (phyloToBranches (lvl - 1) p))
 113          & phylo_viewNodes %~ (++ (groupsToNodes False vb (getFoundations p) gs'))
 114          & phylo_viewEdges %~ (++ (groupsToEdges fl PeriodEdge gs'))
 115          & phylo_viewEdges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
 116          & phylo_viewEdges %~ (++ (groupsToEdges Ascendant LevelEdge  gs'))
 117     where
 118       --------------------------------------
 119       gs :: [PhyloGroup]
 120       gs = getGroupsWithLevel lvl p
 121       --------------------------------------
 122       gs' :: [PhyloGroup]
 123       gs' = getGroupsWithLevel (lvl - 1) p
 124       --------------------------------------
 125
 126
 127 -- | To transform a PhyloQuery into a PhyloView
 128 toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
 129 toPhyloView q p = processDisplay (q ^. qv_display)
 130                 $ processSort (q ^. qv_sort) p
 131                 $ processTaggers (q ^. qv_taggers) p
 132                 $ processFilters (q ^. qv_filters) p
 133                 $ processMetrics (q ^. qv_metrics) p
 134                 $ addChildNodes  (q ^. qv_childs) (q ^. qv_lvl) (q ^. qv_childsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
 135                 $ initPhyloView  (q ^. qv_lvl) (getPhyloTitle p) (getPhyloDescription p) (q ^. qv_filiation) (q ^. qv_verbose) p
 136
 137
 138
 139 -- | To get the PhyloParam of a Phylo
 140 getPhyloParams :: Phylo -> PhyloParam
 141 getPhyloParams = _phylo_param
 142
 143 -- | To get the title of a Phylo
 144 getPhyloTitle :: Phylo -> Text
 145 getPhyloTitle p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
 146
 147 -- | To get the desc of a Phylo
 148 getPhyloDescription :: Phylo -> Text
 149 getPhyloDescription p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p