]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Chart.hs
[ELEVE] Specifications to test to fix concurrent multi-terms.
[gargantext.git] / src / Gargantext / Viz / Chart.hs
1 {-|
2 Module : Gargantext.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 NoImplicitPrelude #-}
13 {-# LANGUAGE TemplateHaskell #-}
14 {-# LANGUAGE DeriveGeneric #-}
15 {-# LANGUAGE RankNTypes #-}
16 {-# LANGUAGE FlexibleContexts #-}
17
18 module Gargantext.Viz.Chart
19 where
20
21
22 import Data.Text (Text)
23 import Data.List (unzip, sortOn)
24 import Data.Map (toList)
25 import GHC.Generics (Generic)
26 import Gargantext.Prelude
27 import Gargantext.Database.Config
28 import Gargantext.Database.Schema.NodeNode (selectDocsDates)
29 import Gargantext.Database.Utils
30 import Gargantext.Database.Types.Node (CorpusId)
31 import Gargantext.Database.Node.Select
32 import Gargantext.Text.Metrics.Count (occurrencesWith)
33 import Gargantext.Core.Types.Main
34
35 -- Pie Chart
36 import Data.Maybe (catMaybes)
37 import qualified Data.Map as Map
38 import qualified Data.List as List
39 import Gargantext.API.Ngrams.Tools
40 import Gargantext.API.Ngrams.NTree
41 import Gargantext.Database.Metrics.NgramsByNode
42 import Gargantext.Database.Schema.Ngrams
43 import Gargantext.Database.Schema.Node
44 import Gargantext.Core.Types
45 import Gargantext.Database.Flow
46
47 import Servant
48
49
50 data Chart = ChartHisto | ChartScatter | ChartPie
51 deriving (Generic)
52
53 -- TODO use UTCTime
54 data Histo = Histo { histo_dates :: [Text]
55 , histo_count :: [Int]
56 }
57 deriving (Generic)
58
59 histoData :: CorpusId -> Cmd err Histo
60 histoData cId = do
61 dates <- selectDocsDates cId
62 let (ls, css) = unzip
63 $ sortOn fst
64 $ toList
65 $ occurrencesWith identity dates
66 pure (Histo ls css)
67
68
69 pieData :: FlowCmdM env err m
70 => CorpusId -> NgramsType -> ListType
71 -> m Histo
72 pieData cId nt lt = do
73 ls' <- selectNodesWithUsername NodeList userMaster
74 ls <- map (_node_id) <$> getListsWithParentId cId
75 ts <- mapTermListRoot ls nt
76 let
77 dico = filterListWithRoot lt ts
78 terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
79 group dico' x = case Map.lookup x dico' of
80 Nothing -> x
81 Just x' -> maybe x identity x'
82
83 (_total,mapTerms) <- countNodesByNgramsWith (group dico)
84 <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
85 let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
86 pure (Histo dates (map round count))
87
88
89
90
91 treeData :: FlowCmdM env err m
92 => CorpusId -> NgramsType -> ListType
93 -> m [MyTree]
94 treeData cId nt lt = do
95 ls' <- selectNodesWithUsername NodeList userMaster
96 ls <- map (_node_id) <$> getListsWithParentId cId
97 ts <- mapTermListRoot ls nt
98
99 let
100 dico = filterListWithRoot lt ts
101 terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
102
103 cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
104
105 m <- getListNgrams ls nt
106 pure $ toTree lt cs' m
107
108
109 treeData' :: FlowCmdM env ServerError m
110 => CorpusId -> NgramsType -> ListType
111 -> m [MyTree]
112 treeData' cId nt lt = do
113 ls' <- selectNodesWithUsername NodeList userMaster
114 ls <- map (_node_id) <$> getListsWithParentId cId
115 ts <- mapTermListRoot ls nt
116
117 let
118 dico = filterListWithRoot lt ts
119 terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
120
121 cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
122
123 m <- getListNgrams ls nt
124 pure $ toTree lt cs' m
125
126