2 Module : Gargantext.Database.Metrics.NgramsByNode
3 Description : Ngrams by Node user and master
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
10 Ngrams by node enable contextual metrics.
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE QuasiQuotes #-}
16 {-# LANGUAGE NoImplicitPrelude #-}
17 {-# LANGUAGE OverloadedStrings #-}
18 {-# LANGUAGE RankNTypes #-}
20 module Gargantext.Database.Action.Metrics.NgramsByNode
23 import Debug.Trace (trace)
24 import Data.Map.Strict (Map, fromListWith, elems, toList, fromList)
25 import Data.Map.Strict.Patch (PatchMap, Replace, diff)
27 import Data.Text (Text)
28 import Data.Tuple.Extra (second, swap)
29 import Database.PostgreSQL.Simple.SqlQQ (sql)
30 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
31 import Gargantext.Core (Lang(..))
32 import Gargantext.Database.Config (nodeTypeId)
33 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
34 import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
35 import Gargantext.Database.Utils (Cmd, runPGSQuery)
36 import Gargantext.Prelude
37 import Gargantext.Text.Metrics.TFICF
38 import Gargantext.Text.Terms.Mono.Stem (stem)
39 import qualified Data.List as List
40 import qualified Data.Map.Strict as Map
41 import qualified Data.Set as Set
42 import qualified Data.Text as Text
43 import qualified Database.PostgreSQL.Simple as DPS
45 -- | TODO: group with 2 terms only can be
46 -- discussed. Main purpose of this is offering
47 -- a first grouping option to user and get some
48 -- enriched data to better learn and improve that algo
49 ngramsGroup :: Lang -> Int -> Int -> Text -> Text
50 ngramsGroup l _m _n = Text.intercalate " "
54 -- . (List.filter (\t -> Text.length t > m))
56 . Text.replace "-" " "
59 sortTficf :: (Map Text (Double, Set Text))
60 -> [ (Text,(Double, Set Text))]
61 sortTficf = List.sortOn (fst . snd) . toList
64 getTficf' :: UserCorpusId -> MasterCorpusId -> NgramsType -> (Text -> Text)
65 -> Cmd err (Map Text (Double, Set Text))
66 getTficf' u m nt f = do
67 u' <- getNodesByNgramsUser u nt
68 m' <- getNodesByNgramsMaster u m
70 pure $ toTficfData (countNodesByNgramsWith f u')
71 (countNodesByNgramsWith f m')
73 getTficfWith :: UserCorpusId -> MasterCorpusId -> [ListId]
74 -> NgramsType -> Map Text (Maybe Text)
75 -> Cmd err (Map Text (Double, Set Text))
76 getTficfWith u m ls nt mtxt = do
77 u' <- getNodesByNgramsOnlyUser u ls nt (Map.keys mtxt)
78 m' <- getNodesByNgramsMaster u m
80 let f x = case Map.lookup x mtxt of
82 Just x' -> maybe x identity x'
84 pure $ toTficfData (countNodesByNgramsWith f u')
85 (countNodesByNgramsWith f m')
88 type Context = (Double, Map Text (Double, Set Text))
92 toTficfData :: Infra -> Supra
93 -> Map Text (Double, Set Text)
94 toTficfData (ti, mi) (ts, ms) =
95 fromList [ (t, ( tficf (TficfInfra (Count n )(Total ti))
96 (TficfSupra (Count $ maybe 0 fst $ Map.lookup t ms)(Total ts))
100 | (t, (n,ns)) <- toList mi
104 -- | fst is size of Supra Corpus
105 -- snd is Texts and size of Occurrences (different docs)
106 countNodesByNgramsWith :: (Text -> Text)
107 -> Map Text (Set NodeId)
108 -> (Double, Map Text (Double, Set Text))
109 countNodesByNgramsWith f m = (total, m')
111 total = fromIntegral $ Set.size $ Set.unions $ elems m
112 m' = Map.map ( swap . second (fromIntegral . Set.size))
113 $ groupNodesByNgramsWith f m
116 groupNodesByNgramsWith :: (Text -> Text)
117 -> Map Text (Set NodeId)
118 -> Map Text (Set Text, Set NodeId)
119 groupNodesByNgramsWith f m =
120 fromListWith (<>) $ map (\(t,ns) -> (f t, (Set.singleton t, ns)))
123 ------------------------------------------------------------------------
124 getNodesByNgramsUser :: CorpusId
126 -> Cmd err (Map Text (Set NodeId))
127 getNodesByNgramsUser cId nt =
128 fromListWith (<>) <$> map (\(n,t) -> (t, Set.singleton n))
129 <$> selectNgramsByNodeUser cId nt
132 selectNgramsByNodeUser :: CorpusId -> NgramsType
133 -> Cmd err [(NodeId, Text)]
134 selectNgramsByNodeUser cId' nt' =
135 runPGSQuery queryNgramsByNodeUser
137 , nodeTypeId NodeDocument
139 -- , 100 :: Int -- limit
140 -- , 0 :: Int -- offset
143 queryNgramsByNodeUser :: DPS.Query
144 queryNgramsByNodeUser = [sql|
145 SELECT nng.node2_id, ng.terms FROM node_node_ngrams nng
146 JOIN ngrams ng ON nng.ngrams_id = ng.id
147 JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
148 JOIN nodes n ON nn.node2_id = n.id
149 WHERE nn.node1_id = ? -- CorpusId
150 AND n.typename = ? -- NodeTypeId
151 AND nng.ngrams_type = ? -- NgramsTypeId
153 GROUP BY nng.node2_id, ng.terms
154 ORDER BY (nng.node2_id, ng.terms) DESC
158 ------------------------------------------------------------------------
160 getOccByNgramsOnlyFast :: CorpusId
163 -> Cmd err (Map Text Int)
164 getOccByNgramsOnlyFast cId nt ngs =
165 fromListWith (+) <$> selectNgramsOccurrencesOnlyByNodeUser cId nt ngs
168 getOccByNgramsOnlyFast' :: CorpusId
172 -> Cmd err (Map Text Int)
173 getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
174 fromListWith (+) <$> map (second round) <$> run cId lId nt tms
177 fields = [QualifiedIdentifier Nothing "text"]
183 -> Cmd err [(Text, Double)]
184 run cId' lId' nt' tms' = runPGSQuery query
185 ( Values fields (DPS.Only <$> tms')
193 WITH input_rows(terms) AS (?)
194 SELECT ng.terms, nng.weight FROM node_node_ngrams nng
195 JOIN ngrams ng ON nng.ngrams_id = ng.id
196 JOIN input_rows ir ON ir.terms = ng.terms
197 WHERE nng.node1_id = ? -- CorpusId
198 AND nng.node2_id = ? -- ListId
199 AND nng.ngrams_type = ? -- NgramsTypeId
200 -- AND nn.category > 0 -- TODO
201 GROUP BY ng.terms, nng.weight
207 -- just slower than getOccByNgramsOnlyFast
208 getOccByNgramsOnlySlow :: NodeType
213 -> Cmd err (Map Text Int)
214 getOccByNgramsOnlySlow t cId ls nt ngs =
215 Map.map Set.size <$> getScore' t cId ls nt ngs
217 getScore' NodeCorpus = getNodesByNgramsOnlyUser
218 getScore' NodeDocument = getNgramsByDocOnlyUser
219 getScore' _ = getNodesByNgramsOnlyUser
221 getOccByNgramsOnlySafe :: CorpusId
225 -> Cmd err (Map Text Int)
226 getOccByNgramsOnlySafe cId ls nt ngs = do
227 printDebug "getOccByNgramsOnlySafe" (cId, nt, length ngs)
228 fast <- getOccByNgramsOnlyFast cId nt ngs
229 slow <- getOccByNgramsOnlySlow NodeCorpus cId ls nt ngs
230 when (fast /= slow) $
231 printDebug "getOccByNgramsOnlySafe: difference" (diff slow fast :: PatchMap Text (Replace (Maybe Int)))
235 selectNgramsOccurrencesOnlyByNodeUser :: CorpusId -> NgramsType -> [Text]
236 -> Cmd err [(Text, Int)]
237 selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
238 runPGSQuery queryNgramsOccurrencesOnlyByNodeUser
239 ( Values fields (DPS.Only <$> tms)
241 , nodeTypeId NodeDocument
245 fields = [QualifiedIdentifier Nothing "text"]
247 -- same as queryNgramsOnlyByNodeUser but using COUNT on the node ids.
248 -- Question: with the grouping is the result exactly the same (since Set NodeId for
249 -- equivalent ngrams intersections are not empty)
250 queryNgramsOccurrencesOnlyByNodeUser :: DPS.Query
251 queryNgramsOccurrencesOnlyByNodeUser = [sql|
252 WITH input_rows(terms) AS (?)
253 SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
254 JOIN ngrams ng ON nng.ngrams_id = ng.id
255 JOIN input_rows ir ON ir.terms = ng.terms
256 JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
257 JOIN nodes n ON nn.node2_id = n.id
258 WHERE nn.node1_id = ? -- CorpusId
259 AND n.typename = ? -- NodeTypeId
260 AND nng.ngrams_type = ? -- NgramsTypeId
262 GROUP BY nng.node2_id, ng.terms
267 queryNgramsOccurrencesOnlyByNodeUser' :: DPS.Query
268 queryNgramsOccurrencesOnlyByNodeUser' = [sql|
269 WITH input_rows(terms) AS (?)
270 SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
271 JOIN ngrams ng ON nng.ngrams_id = ng.id
272 JOIN input_rows ir ON ir.terms = ng.terms
273 JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
274 JOIN nodes n ON nn.node2_id = n.id
275 WHERE nn.node1_id = ? -- CorpusId
276 AND n.typename = ? -- NodeTypeId
277 AND nng.ngrams_type = ? -- NgramsTypeId
279 GROUP BY nng.node2_id, ng.terms
282 ------------------------------------------------------------------------
284 getNodesByNgramsOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
285 -> Cmd err (Map Text (Set NodeId))
286 getNodesByNgramsOnlyUser cId ls nt ngs =
288 . map (fromListWith (<>)
289 . map (second Set.singleton))
290 <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
291 (splitEvery 1000 ngs)
294 getNgramsByNodeOnlyUser :: NodeId
298 -> Cmd err (Map NodeId (Set Text))
299 getNgramsByNodeOnlyUser cId ls nt ngs =
301 . map (fromListWith (<>)
302 . map (second Set.singleton))
304 <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
305 (splitEvery 1000 ngs)
307 ------------------------------------------------------------------------
308 selectNgramsOnlyByNodeUser :: CorpusId -> [ListId] -> NgramsType -> [Text]
309 -> Cmd err [(Text, NodeId)]
310 selectNgramsOnlyByNodeUser cId ls nt tms =
311 runPGSQuery queryNgramsOnlyByNodeUser
312 ( Values fields (DPS.Only <$> tms)
313 , Values [QualifiedIdentifier Nothing "int4"] (DPS.Only <$> (map (\(NodeId n) -> n) ls))
315 , nodeTypeId NodeDocument
319 fields = [QualifiedIdentifier Nothing "text"]
321 queryNgramsOnlyByNodeUser :: DPS.Query
322 queryNgramsOnlyByNodeUser = [sql|
323 WITH input_rows(terms) AS (?),
324 input_list(id) AS (?)
325 SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
326 JOIN ngrams ng ON nng.ngrams_id = ng.id
327 JOIN input_rows ir ON ir.terms = ng.terms
328 JOIN input_list il ON il.id = nng.node1_id
329 JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
330 JOIN nodes n ON nn.node2_id = n.id
331 WHERE nn.node1_id = ? -- CorpusId
332 AND n.typename = ? -- NodeTypeId
333 AND nng.ngrams_type = ? -- NgramsTypeId
335 GROUP BY ng.terms, nng.node2_id
340 selectNgramsOnlyByNodeUser' :: CorpusId -> [ListId] -> NgramsType -> [Text]
341 -> Cmd err [(Text, Int)]
342 selectNgramsOnlyByNodeUser' cId ls nt tms =
343 runPGSQuery queryNgramsOnlyByNodeUser
344 ( Values fields (DPS.Only <$> tms)
345 , Values [QualifiedIdentifier Nothing "int4"] (DPS.Only <$> (map (\(NodeId n) -> n) ls))
347 , nodeTypeId NodeDocument
351 fields = [QualifiedIdentifier Nothing "text"]
353 queryNgramsOnlyByNodeUser' :: DPS.Query
354 queryNgramsOnlyByNodeUser' = [sql|
355 WITH input_rows(terms) AS (?),
356 input_list(id) AS (?)
357 SELECT ng.terms, nng.weight FROM node_node_ngrams nng
358 JOIN ngrams ng ON nng.ngrams_id = ng.id
359 JOIN input_rows ir ON ir.terms = ng.terms
360 JOIN input_list il ON il.id = nng.node2_id
361 WHERE nng.node1_id = ? -- CorpusId
362 AND nng.ngrams_type = ? -- NgramsTypeId
363 -- AND nn.category > 0
364 GROUP BY ng.terms, nng.weight
369 getNgramsByDocOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
370 -> Cmd err (Map Text (Set NodeId))
371 getNgramsByDocOnlyUser cId ls nt ngs =
373 . map (fromListWith (<>) . map (second Set.singleton))
374 <$> mapM (selectNgramsOnlyByDocUser cId ls nt) (splitEvery 1000 ngs)
377 selectNgramsOnlyByDocUser :: DocId -> [ListId] -> NgramsType -> [Text]
378 -> Cmd err [(Text, NodeId)]
379 selectNgramsOnlyByDocUser dId ls nt tms =
380 runPGSQuery queryNgramsOnlyByDocUser
381 ( Values fields (DPS.Only <$> tms)
382 , Values [QualifiedIdentifier Nothing "int4"] (DPS.Only <$> (map (\(NodeId n) -> n) ls))
387 fields = [QualifiedIdentifier Nothing "text"]
389 queryNgramsOnlyByDocUser :: DPS.Query
390 queryNgramsOnlyByDocUser = [sql|
391 WITH input_rows(terms) AS (?),
392 input_list(id) AS (?)
393 SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
394 JOIN ngrams ng ON nng.ngrams_id = ng.id
395 JOIN input_rows ir ON ir.terms = ng.terms
396 JOIN input_list il ON il.id = nng.node1_id
397 WHERE nng.node2_id = ? -- DocId
398 AND nng.ngrams_type = ? -- NgramsTypeId
399 GROUP BY ng.terms, nng.node2_id
402 ------------------------------------------------------------------------
403 -- | TODO filter by language, database, any social field
404 getNodesByNgramsMaster :: UserCorpusId -> MasterCorpusId -> Cmd err (Map Text (Set NodeId))
405 getNodesByNgramsMaster ucId mcId = Map.unionsWith (<>)
406 . map (fromListWith (<>) . map (\(n,t) -> (t, Set.singleton n)))
407 -- . takeWhile (not . List.null)
408 -- . takeWhile (\l -> List.length l > 3)
409 <$> mapM (selectNgramsByNodeMaster 1000 ucId mcId) [0,500..10000]
412 selectNgramsByNodeMaster :: Int -> UserCorpusId -> MasterCorpusId -> Int -> Cmd err [(NodeId, Text)]
413 selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
414 queryNgramsByNodeMaster'
416 , ngramsTypeId NgramsTerms
417 , nodeTypeId NodeDocument
419 , nodeTypeId NodeDocument
423 , nodeTypeId NodeDocument
424 , ngramsTypeId NgramsTerms
427 -- | TODO fix node_node_ngrams relation
428 queryNgramsByNodeMaster' :: DPS.Query
429 queryNgramsByNodeMaster' = [sql|
430 WITH nodesByNgramsUser AS (
432 SELECT n.id, ng.terms FROM nodes n
433 JOIN nodes_nodes nn ON n.id = nn.node2_id
434 JOIN node_node_ngrams nng ON nng.node2_id = n.id
435 JOIN ngrams ng ON nng.ngrams_id = ng.id
436 WHERE nn.node1_id = ? -- UserCorpusId
437 -- AND n.typename = ? -- NodeTypeId
438 AND nng.ngrams_type = ? -- NgramsTypeId
440 AND node_pos(n.id,?) >= ?
441 AND node_pos(n.id,?) < ?
442 GROUP BY n.id, ng.terms
446 nodesByNgramsMaster AS (
448 SELECT n.id, ng.terms FROM nodes n TABLESAMPLE SYSTEM_ROWS(?)
449 JOIN node_node_ngrams nng ON n.id = nng.node2_id
450 JOIN ngrams ng ON ng.id = nng.ngrams_id
452 WHERE n.parent_id = ? -- Master Corpus NodeTypeId
453 AND n.typename = ? -- NodeTypeId
454 AND nng.ngrams_type = ? -- NgramsTypeId
455 GROUP BY n.id, ng.terms
458 SELECT m.id, m.terms FROM nodesByNgramsMaster m
459 RIGHT JOIN nodesByNgramsUser u ON u.id = m.id