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.NodeContext (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.Types
  39 import Gargantext.Database.Action.Metrics.NgramsByContext
  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 ls
  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) <- countContextsByNgramsWith (group dico)
  71                     <$> getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
  72   let (dates, count) = V.unzip $
  73                        V.fromList $
  74                        List.sortOn snd $
  75                        (\(NgramsTerm t,(d,_)) -> (t, d)) <$>
  76                        HashMap.toList mapTerms
  77   pure (Histo dates (round <$> count))
  78
  79
  80 treeData :: FlowCmdM env err m
  81         => CorpusId -> NgramsType -> ListType
  82         -> m (V.Vector NgramsTree)
  83 treeData cId nt lt = do
  84   ls' <- selectNodesWithUsername NodeList userMaster
  85   ls <- map (_node_id) <$> getListsWithParentId cId
  86   ts <- mapTermListRoot ls nt <$> getRepo ls
  87
  88   let
  89     dico = filterListWithRoot [lt] ts
  90     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
  91
  92   cs' <- getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
  93
  94   m  <- getListNgrams ls nt
  95   pure $ V.fromList $ toTree lt cs' m
  96