src/Gargantext/Core/Viz/Chart.hs

   1 {-|
   2 Module      : Gargantext.Core.Viz.Chart
   3 Description : Graph utils
   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 {-# LANGUAGE TemplateHaskell   #-}
  13
  14 module Gargantext.Core.Viz.Chart
  15   where
  16
  17 import Data.List (sortOn)
  18 import Data.Map (toList)
  19 import qualified Data.List as List
  20 import Data.Maybe (catMaybes)
  21 import qualified Data.Vector as V
  22
  23 import Gargantext.Core.Types.Main
  24 import Gargantext.Database.Admin.Config
  25 import Gargantext.Database.Prelude
  26 import Gargantext.Database.Query.Table.Node
  27 import Gargantext.Database.Query.Table.Node.Select
  28 import Gargantext.Database.Query.Table.NodeNode (selectDocsDates)
  29 import Gargantext.Database.Schema.Node
  30 import Gargantext.Prelude
  31 import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
  32
  33 -- Pie Chart
  34 import Gargantext.API.Ngrams.NgramsTree
  35 import Gargantext.API.Ngrams.Tools
  36 import Gargantext.API.Ngrams.Types
  37 import Gargantext.Core.Types
  38 import Gargantext.Database.Action.Flow
  39 import Gargantext.Database.Action.Metrics.NgramsByNode
  40 import Gargantext.Database.Schema.Ngrams
  41 import Gargantext.Core.Viz.Types
  42 import qualified Data.HashMap.Strict as HashMap
  43
  44
  45 histoData :: CorpusId -> Cmd err Histo
  46 histoData cId = do
  47   dates <- selectDocsDates cId
  48   let (ls, css) = V.unzip
  49                 $ V.fromList
  50                 $ sortOn fst -- TODO Vector.sortOn
  51                 $ toList
  52                 $ occurrencesWith identity dates
  53   pure (Histo ls css)
  54
  55
  56 chartData :: FlowCmdM env err m
  57         => CorpusId -> NgramsType -> ListType
  58         -> m Histo
  59 chartData cId nt lt = do
  60   ls' <- selectNodesWithUsername NodeList userMaster
  61   ls <- map (_node_id) <$> getListsWithParentId cId
  62   ts <- mapTermListRoot ls nt <$> getRepo
  63   let
  64     dico = filterListWithRoot lt ts
  65     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
  66     group dico' x = case HashMap.lookup x dico' of
  67         Nothing -> x
  68         Just x' -> maybe x identity x'
  69
  70   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
  71                     <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
  72   let (dates, count) = V.unzip $ fmap (\(NgramsTerm t,(d,_)) -> (t, d)) $ V.fromList $ HashMap.toList mapTerms
  73   pure (Histo dates (round <$> count))
  74
  75
  76 treeData :: FlowCmdM env err m
  77         => CorpusId -> NgramsType -> ListType
  78         -> m (V.Vector NgramsTree)
  79 treeData cId nt lt = do
  80   ls' <- selectNodesWithUsername NodeList userMaster
  81   ls <- map (_node_id) <$> getListsWithParentId cId
  82   ts <- mapTermListRoot ls nt <$> getRepo
  83
  84   let
  85     dico = filterListWithRoot lt ts
  86     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
  87
  88   cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
  89
  90   m  <- getListNgrams ls nt
  91   pure $ V.fromList $ toTree lt cs' m
  92