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