Chart.hs 2.9 KB
Newer Older
1
{-|
2
Module      : Gargantext.Core.Viz.Chart
3
Description : Graph utils
4 5 6 7 8 9 10 11
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

12
{-# LANGUAGE TemplateHaskell   #-}
13

14
module Gargantext.Core.Viz.Chart
15
  where
16

Nicolas Pouillard's avatar
Nicolas Pouillard committed
17
import Data.List (sortOn)
18
import Data.Map (toList)
19 20
import qualified Data.List as List
import Data.Maybe (catMaybes)
Nicolas Pouillard's avatar
Nicolas Pouillard committed
21
import qualified Data.Vector as V
22

23 24
import Gargantext.Core.Types.Main
import Gargantext.Database.Admin.Config
25
import Gargantext.Database.Prelude
26 27
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Select
28
import Gargantext.Database.Query.Table.NodeNode (selectDocsDates)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
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.NgramsByNode
40
import Gargantext.Database.Schema.Ngrams
41
import Gargantext.Core.Viz.Types
42 43
import qualified Data.HashMap.Strict as HashMap

44 45 46 47

histoData :: CorpusId -> Cmd err Histo
histoData cId = do
  dates <- selectDocsDates cId
Nicolas Pouillard's avatar
Nicolas Pouillard committed
48 49 50
  let (ls, css) = V.unzip
                $ V.fromList
                $ sortOn fst -- TODO Vector.sortOn
51 52 53 54
                $ toList
                $ occurrencesWith identity dates
  pure (Histo ls css)

55

56
chartData :: FlowCmdM env err m
57 58
        => CorpusId -> NgramsType -> ListType
        -> 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 64
  let
    dico = filterListWithRoot lt ts
65 66
    terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
    group dico' x = case HashMap.lookup x dico' of
67 68 69 70
        Nothing -> x
        Just x' -> maybe x identity x'

  (_total,mapTerms) <- countNodesByNgramsWith (group dico)
71
                    <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
72 73 74 75 76
  let (dates, count) = V.unzip $
                       V.fromList $
                       List.sortOn snd $
                       (\(NgramsTerm t,(d,_)) -> (t, d)) <$>
                       HashMap.toList mapTerms
77
  pure (Histo dates (round <$> count))
78 79 80 81


treeData :: FlowCmdM env err m
        => 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 89

  let
    dico = filterListWithRoot lt ts
90
    terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
91

92
  cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
93

94
  m  <- getListNgrams ls nt
95
  pure $ V.fromList $ toTree lt cs' m
96