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