/ src / Gargantext / Core / Viz / Chart.hs
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  module Gargantext.Core.Viz.Chart
13    where
14  
15  import Data.HashMap.Strict qualified as HashMap
16  import Data.List qualified as List
17  import Data.Map.Strict (toList)
18  import Data.Set qualified as Set
19  import Data.Vector qualified as V
20  import Gargantext.API.Ngrams.NgramsTree ( toTree, NgramsTree )
21  import Gargantext.API.Ngrams.Tools ( filterListWithRoot, getListNgrams, getRepo, mapTermListRoot )
22  import Gargantext.API.Ngrams.Types ( NgramsTerm(NgramsTerm) )
23  import Gargantext.Core.NodeStory.Types ( HasNodeStory )
24  import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
25  import Gargantext.Core.Text.Ngrams (NgramsType)
26  import Gargantext.Core.Types.Main ( ListType )
27  import Gargantext.Database.Admin.Types.Node ( NodeType(NodeList), CorpusId, contextId2NodeId )
28  import Gargantext.Core.Viz.Types ( Histo(Histo) )
29  import Gargantext.Database.Action.Metrics.NgramsByContext ( countContextsByNgramsWith, getContextsByNgramsOnlyUser )
30  import Gargantext.Database.Admin.Config ( userMaster )
31  import Gargantext.Database.Prelude (DBCmd)
32  import Gargantext.Database.Query.Table.Node ( getListsWithParentId )
33  import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
34  import Gargantext.Database.Query.Table.NodeContext (selectDocsDates)
35  import Gargantext.Database.Schema.Node ( NodePoly(_node_id) )
36  import Gargantext.Prelude hiding (toList)
37  
38  
39  histoData :: CorpusId -> DBCmd err Histo
40  histoData cId = do
41    dates <- selectDocsDates cId
42    let (ls, css) = V.unzip
43                  $ V.fromList
44                  $ sortOn fst -- TODO Vector.sortOn
45                  $ toList
46                  $ occurrencesWith identity dates
47    pure (Histo ls css)
48  
49  
50  chartData :: HasNodeStory env err m
51            => CorpusId -> NgramsType -> ListType
52            -> m Histo
53  chartData cId nt lt = do
54    ls' <- selectNodesWithUsername NodeList userMaster
55    ls <- map (_node_id) <$> getListsWithParentId cId
56    ts <- mapTermListRoot ls nt <$> getRepo ls
57    let
58      dico = filterListWithRoot [lt] ts
59      terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
60      group' dico' x = case HashMap.lookup x dico' of
61          Nothing -> x
62          Just x' -> maybe x identity x'
63  
64    (_total,mapTerms) <- countContextsByNgramsWith (group' dico)
65                      <$> getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
66    let (dates, count) = V.unzip $
67                         V.fromList $
68                         List.sortOn snd $
69                         (\(NgramsTerm t,(d,_)) -> (t, d)) <$>
70                         HashMap.toList mapTerms
71    pure (Histo dates (round <$> count))
72  
73  
74  treeData :: HasNodeStory env err m
75          => CorpusId -> NgramsType -> ListType
76          -> m (V.Vector NgramsTree)
77  treeData cId nt lt = do
78    ls' <- selectNodesWithUsername NodeList userMaster
79    ls <- map (_node_id) <$> getListsWithParentId cId
80    ts <- mapTermListRoot ls nt <$> getRepo ls
81  
82    let
83      dico = filterListWithRoot [lt] ts
84      terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
85  
86    -- FIXME(adn) Audit the usage, as we are converting between a context id to a node id.
87    cs' <- HashMap.map (Set.map contextId2NodeId) <$> getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
88  
89    m  <- getListNgrams ls nt
90    pure $ V.fromList $ toTree lt cs' m