src/Gargantext/Database/Metrics/NgramsByNode.hs

   1 {-|
   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
   8 Portability : POSIX
   9
  10 Ngrams by node enable contextual metrics.
  11
  12 -}
  13
  14 {-# LANGUAGE QuasiQuotes       #-}
  15 {-# LANGUAGE NoImplicitPrelude #-}
  16 {-# LANGUAGE OverloadedStrings #-}
  17 {-# LANGUAGE RankNTypes        #-}
  18
  19 module Gargantext.Database.Metrics.NgramsByNode
  20   where
  21
  22 import Debug.Trace (trace)
  23 import Data.Map.Strict (Map, fromListWith, elems, toList, fromList)
  24 import Data.Map.Strict.Patch (PatchMap, Replace, diff)
  25 import Data.Set (Set)
  26 import Data.Text (Text)
  27 import Data.Tuple.Extra (second, swap)
  28 import Database.PostgreSQL.Simple.SqlQQ (sql)
  29 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  30 import Gargantext.Core (Lang(..))
  31 import Gargantext.Database.Config (nodeTypeId)
  32 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
  33 import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
  34 import Gargantext.Database.Utils (Cmd, runPGSQuery)
  35 import Gargantext.Prelude
  36 import Gargantext.Text.Metrics.TFICF
  37 import Gargantext.Text.Terms.Mono.Stem (stem)
  38 import qualified Data.List as List
  39 import qualified Data.Map.Strict as Map
  40 import qualified Data.Set as Set
  41 import qualified Data.Text as Text
  42 import qualified Database.PostgreSQL.Simple as DPS
  43
  44 -- | TODO: group with 2 terms only can be
  45 -- discussed. Main purpose of this is offering
  46 -- a first grouping option to user and get some
  47 -- enriched data to better learn and improve that algo
  48 ngramsGroup :: Lang -> Int -> Int -> Text -> Text
  49 ngramsGroup l _m _n = Text.intercalate " "
  50                   . map (stem l)
  51                   -- . take n
  52                   . List.sort
  53                   -- . (List.filter (\t -> Text.length t > m))
  54                   . Text.splitOn " "
  55                   . Text.replace "-" " "
  56
  57
  58 sortTficf :: (Map Text (Double, Set Text))
  59           -> [   (Text,(Double, Set Text))]
  60 sortTficf  = List.sortOn (fst . snd) . toList
  61
  62
  63 getTficf' :: UserCorpusId -> MasterCorpusId -> NgramsType -> (Text -> Text)
  64          -> Cmd err (Map Text (Double, Set Text))
  65 getTficf' u m nt f = do
  66   u' <- getNodesByNgramsUser   u nt
  67   m' <- getNodesByNgramsMaster u m
  68
  69   pure $ toTficfData (countNodesByNgramsWith f u')
  70                      (countNodesByNgramsWith f m')
  71
  72 getTficfWith :: UserCorpusId -> MasterCorpusId -> [ListId]
  73            -> NgramsType -> Map Text (Maybe Text)
  74            -> Cmd err (Map Text (Double, Set Text))
  75 getTficfWith u m ls nt mtxt = do
  76   u' <- getNodesByNgramsOnlyUser   u ls nt (Map.keys mtxt)
  77   m' <- getNodesByNgramsMaster     u m
  78
  79   let f x = case Map.lookup x mtxt of
  80         Nothing -> x
  81         Just x' -> maybe x identity x'
  82
  83   pure $ toTficfData (countNodesByNgramsWith f u')
  84                      (countNodesByNgramsWith f m')
  85
  86
  87 type Context = (Double, Map Text (Double, Set Text))
  88 type Supra   = Context
  89 type Infra   = Context
  90
  91 toTficfData :: Infra -> Supra
  92             -> Map Text (Double, Set Text)
  93 toTficfData (ti, mi) (ts, ms) =
  94   fromList [ (t, ( tficf (TficfInfra (Count n                              )(Total ti))
  95                          (TficfSupra (Count $ maybe 0 fst $ Map.lookup t ms)(Total ts))
  96                  , ns
  97                  )
  98              )
  99            | (t, (n,ns)) <- toList mi
 100            ]
 101
 102
 103 -- | fst is size of Supra Corpus
 104 --   snd is Texts and size of Occurrences (different docs)
 105 countNodesByNgramsWith :: (Text -> Text)
 106                        -> Map Text (Set NodeId)
 107                        -> (Double, Map Text (Double, Set Text))
 108 countNodesByNgramsWith f m = (total, m')
 109   where
 110     total = fromIntegral $ Set.size $ Set.unions $ elems m
 111     m'    = Map.map ( swap . second (fromIntegral . Set.size))
 112                     $ groupNodesByNgramsWith f m
 113
 114
 115 groupNodesByNgramsWith :: (Text -> Text)
 116                        -> Map Text (Set NodeId)
 117                        -> Map Text (Set Text, Set NodeId)
 118 groupNodesByNgramsWith f m =
 119       fromListWith (<>) $ map (\(t,ns) -> (f t, (Set.singleton t, ns)))
 120                         $ toList m
 121
 122 ------------------------------------------------------------------------
 123 getNodesByNgramsUser :: CorpusId
 124                      -> NgramsType
 125                      -> Cmd err (Map Text (Set NodeId))
 126 getNodesByNgramsUser cId nt =
 127   fromListWith (<>) <$> map (\(n,t) -> (t, Set.singleton n))
 128                     <$> selectNgramsByNodeUser cId nt
 129     where
 130
 131       selectNgramsByNodeUser :: CorpusId -> NgramsType
 132                              -> Cmd err [(NodeId, Text)]
 133       selectNgramsByNodeUser cId' nt' =
 134         runPGSQuery queryNgramsByNodeUser
 135                     ( cId'
 136                     , nodeTypeId NodeDocument
 137                     , ngramsTypeId nt'
 138            --         , 100 :: Int -- limit
 139            --         , 0   :: Int -- offset
 140                     )
 141
 142       queryNgramsByNodeUser :: DPS.Query
 143       queryNgramsByNodeUser = [sql|
 144         SELECT nng.node2_id, ng.terms FROM node_node_ngrams nng
 145           JOIN ngrams ng      ON nng.ngrams_id = ng.id
 146           JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
 147           JOIN nodes  n       ON nn.node2_id   = n.id
 148           WHERE nn.node1_id = ?     -- CorpusId
 149             AND n.typename  = ?     -- NodeTypeId
 150             AND nng.ngrams_type = ? -- NgramsTypeId
 151             AND nn.category > 0
 152             GROUP BY nng.node2_id, ng.terms
 153             ORDER BY (nng.node2_id, ng.terms) DESC
 154           --   LIMIT ?
 155           --  OFFSET ?
 156         |]
 157 ------------------------------------------------------------------------
 158 -- TODO add groups
 159 getOccByNgramsOnlyFast :: CorpusId
 160                        -> NgramsType
 161                        -> [Text]
 162                        -> Cmd err (Map Text Int)
 163 getOccByNgramsOnlyFast cId nt ngs =
 164   fromListWith (+) <$> selectNgramsOccurrencesOnlyByNodeUser cId nt ngs
 165
 166
 167 getOccByNgramsOnlyFast' :: CorpusId
 168                        -> ListId
 169                        -> NgramsType
 170                        -> [Text]
 171                        -> Cmd err (Map Text Int)
 172 getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
 173   fromListWith (+) <$> map (second round) <$> run cId lId nt tms
 174
 175     where
 176       fields = [QualifiedIdentifier Nothing "text"]
 177
 178       run :: CorpusId
 179            -> ListId
 180            -> NgramsType
 181            -> [Text]
 182            -> Cmd err [(Text, Double)]
 183       run cId' lId' nt' tms' = runPGSQuery query
 184                 ( Values fields (DPS.Only <$> tms')
 185                 , cId'
 186                 , lId'
 187                 , ngramsTypeId nt'
 188                 )
 189
 190       query :: DPS.Query
 191       query = [sql|
 192         WITH input_rows(terms) AS (?)
 193         SELECT ng.terms, nng.weight FROM node_node_ngrams nng
 194           JOIN ngrams ng      ON nng.ngrams_id = ng.id
 195           JOIN input_rows  ir ON ir.terms      = ng.terms
 196           WHERE nng.node1_id     = ?   -- CorpusId
 197             AND nng.node2_id     = ?   -- ListId
 198             AND nng.ngrams_type  = ? -- NgramsTypeId
 199             -- AND nn.category     > 0 -- TODO
 200             GROUP BY ng.terms, nng.weight
 201         |]
 202
 203
 204
 205
 206 -- just slower than getOccByNgramsOnlyFast
 207 getOccByNgramsOnlySlow :: NodeType
 208                        -> CorpusId
 209                        -> [ListId]
 210                        -> NgramsType
 211                        -> [Text]
 212                        -> Cmd err (Map Text Int)
 213 getOccByNgramsOnlySlow t cId ls nt ngs =
 214   Map.map Set.size <$> getScore' t cId ls nt ngs
 215     where
 216       getScore' NodeCorpus   = getNodesByNgramsOnlyUser
 217       getScore' NodeDocument = getNgramsByDocOnlyUser
 218       getScore' _            = getNodesByNgramsOnlyUser
 219
 220 getOccByNgramsOnlySafe :: CorpusId
 221                        -> [ListId]
 222                        -> NgramsType
 223                        -> [Text]
 224                        -> Cmd err (Map Text Int)
 225 getOccByNgramsOnlySafe cId ls nt ngs = do
 226   printDebug "getOccByNgramsOnlySafe" (cId, nt, length ngs)
 227   fast <- getOccByNgramsOnlyFast cId nt ngs
 228   slow <- getOccByNgramsOnlySlow NodeCorpus cId ls nt ngs
 229   when (fast /= slow) $
 230     printDebug "getOccByNgramsOnlySafe: difference" (diff slow fast :: PatchMap Text (Replace (Maybe Int)))
 231   pure slow
 232
 233
 234 selectNgramsOccurrencesOnlyByNodeUser :: CorpusId -> NgramsType -> [Text]
 235                            -> Cmd err [(Text, Int)]
 236 selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
 237   runPGSQuery queryNgramsOccurrencesOnlyByNodeUser
 238                 ( Values fields (DPS.Only <$> tms)
 239                 , cId
 240                 , nodeTypeId NodeDocument
 241                 , ngramsTypeId nt
 242                 )
 243     where
 244       fields = [QualifiedIdentifier Nothing "text"]
 245
 246 -- same as queryNgramsOnlyByNodeUser but using COUNT on the node ids.
 247 -- Question: with the grouping is the result exactly the same (since Set NodeId for
 248 -- equivalent ngrams intersections are not empty)
 249 queryNgramsOccurrencesOnlyByNodeUser :: DPS.Query
 250 queryNgramsOccurrencesOnlyByNodeUser = [sql|
 251   WITH input_rows(terms) AS (?)
 252   SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
 253     JOIN ngrams ng      ON nng.ngrams_id = ng.id
 254     JOIN input_rows  ir ON ir.terms      = ng.terms
 255     JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
 256     JOIN nodes  n       ON nn.node2_id   = n.id
 257     WHERE nn.node1_id     = ? -- CorpusId
 258       AND n.typename      = ? -- NodeTypeId
 259       AND nng.ngrams_type = ? -- NgramsTypeId
 260       AND nn.category     > 0
 261       GROUP BY nng.node2_id, ng.terms
 262   |]
 263
 264
 265
 266 queryNgramsOccurrencesOnlyByNodeUser' :: DPS.Query
 267 queryNgramsOccurrencesOnlyByNodeUser' = [sql|
 268   WITH input_rows(terms) AS (?)
 269   SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
 270     JOIN ngrams ng      ON nng.ngrams_id = ng.id
 271     JOIN input_rows  ir ON ir.terms      = ng.terms
 272     JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
 273     JOIN nodes  n       ON nn.node2_id   = n.id
 274     WHERE nn.node1_id     = ? -- CorpusId
 275       AND n.typename      = ? -- NodeTypeId
 276       AND nng.ngrams_type = ? -- NgramsTypeId
 277       AND nn.category     > 0
 278       GROUP BY nng.node2_id, ng.terms
 279   |]
 280
 281
 282 getNodesByNgramsOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
 283                          -> Cmd err (Map Text (Set NodeId))
 284 getNodesByNgramsOnlyUser cId ls nt ngs =
 285   Map.unionsWith (<>)
 286    . map (fromListWith (<>) . map (second Set.singleton))
 287   <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
 288            (splitEvery 1000 ngs)
 289
 290 selectNgramsOnlyByNodeUser :: CorpusId -> [ListId] -> NgramsType -> [Text]
 291                            -> Cmd err [(Text, NodeId)]
 292 selectNgramsOnlyByNodeUser cId ls nt tms =
 293   runPGSQuery queryNgramsOnlyByNodeUser
 294                 ( Values fields (DPS.Only <$> tms)
 295                 , Values [QualifiedIdentifier Nothing "int4"] (DPS.Only <$> (map (\(NodeId n) -> n) ls))
 296                 , cId
 297                 , nodeTypeId NodeDocument
 298                 , ngramsTypeId nt
 299                 )
 300     where
 301       fields = [QualifiedIdentifier Nothing "text"]
 302
 303 queryNgramsOnlyByNodeUser :: DPS.Query
 304 queryNgramsOnlyByNodeUser = [sql|
 305   WITH input_rows(terms) AS (?),
 306        input_list(id)    AS (?)
 307   SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
 308     JOIN ngrams ng      ON nng.ngrams_id = ng.id
 309     JOIN input_rows  ir ON ir.terms      = ng.terms
 310     JOIN input_list  il ON il.id         = nng.node1_id
 311     JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
 312     JOIN nodes  n       ON nn.node2_id   = n.id
 313     WHERE nn.node1_id     = ? -- CorpusId
 314       AND n.typename      = ? -- NodeTypeId
 315       AND nng.ngrams_type = ? -- NgramsTypeId
 316       AND nn.category     > 0
 317       GROUP BY ng.terms, nng.node2_id
 318   |]
 319
 320
 321
 322
 323 selectNgramsOnlyByNodeUser' :: CorpusId -> [ListId] -> NgramsType -> [Text]
 324                            -> Cmd err [(Text, Int)]
 325 selectNgramsOnlyByNodeUser' cId ls nt tms =
 326   runPGSQuery queryNgramsOnlyByNodeUser
 327                 ( Values fields (DPS.Only <$> tms)
 328                 , Values [QualifiedIdentifier Nothing "int4"] (DPS.Only <$> (map (\(NodeId n) -> n) ls))
 329                 , cId
 330                 , nodeTypeId NodeDocument
 331                 , ngramsTypeId nt
 332                 )
 333     where
 334       fields = [QualifiedIdentifier Nothing "text"]
 335
 336 queryNgramsOnlyByNodeUser' :: DPS.Query
 337 queryNgramsOnlyByNodeUser' = [sql|
 338   WITH input_rows(terms) AS (?),
 339        input_list(id)    AS (?)
 340   SELECT ng.terms, nng.weight FROM node_node_ngrams nng
 341     JOIN ngrams ng      ON nng.ngrams_id = ng.id
 342     JOIN input_rows  ir ON ir.terms      = ng.terms
 343     JOIN input_list  il ON il.id         = nng.node2_id
 344     WHERE nng.node1_id     = ? -- CorpusId
 345       AND nng.ngrams_type = ? -- NgramsTypeId
 346       -- AND nn.category     > 0
 347       GROUP BY ng.terms, nng.weight
 348   |]
 349
 350
 351
 352
 353 getNgramsByDocOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
 354                          -> Cmd err (Map Text (Set NodeId))
 355 getNgramsByDocOnlyUser cId ls nt ngs =
 356   Map.unionsWith (<>)
 357   . map (fromListWith (<>) . map (second Set.singleton))
 358   <$> mapM (selectNgramsOnlyByDocUser cId ls nt) (splitEvery 1000 ngs)
 359
 360
 361 selectNgramsOnlyByDocUser :: DocId -> [ListId] -> NgramsType -> [Text]
 362                            -> Cmd err [(Text, NodeId)]
 363 selectNgramsOnlyByDocUser dId ls nt tms =
 364   runPGSQuery queryNgramsOnlyByDocUser
 365                 ( Values fields (DPS.Only <$> tms)
 366                 , Values [QualifiedIdentifier Nothing "int4"] (DPS.Only <$> (map (\(NodeId n) -> n) ls))
 367                 , dId
 368                 , ngramsTypeId nt
 369                 )
 370     where
 371       fields = [QualifiedIdentifier Nothing "text"]
 372
 373 queryNgramsOnlyByDocUser :: DPS.Query
 374 queryNgramsOnlyByDocUser = [sql|
 375   WITH input_rows(terms) AS (?),
 376        input_list(id)    AS (?)
 377   SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
 378     JOIN ngrams ng      ON nng.ngrams_id = ng.id
 379     JOIN input_rows  ir ON ir.terms      = ng.terms
 380     JOIN input_list  il ON il.id         = nng.node1_id
 381     WHERE nng.node2_id     = ? -- DocId
 382       AND nng.ngrams_type = ? -- NgramsTypeId
 383       GROUP BY ng.terms, nng.node2_id
 384   |]
 385
 386 ------------------------------------------------------------------------
 387 -- | TODO filter by language, database, any social field
 388 getNodesByNgramsMaster :: UserCorpusId -> MasterCorpusId -> Cmd err (Map Text (Set NodeId))
 389 getNodesByNgramsMaster ucId mcId = Map.unionsWith (<>)
 390                                  . map (fromListWith (<>) . map (\(n,t) -> (t, Set.singleton n)))
 391                                  -- . takeWhile (not . List.null)
 392                                  -- . takeWhile (\l -> List.length l > 3)
 393                                 <$> mapM (selectNgramsByNodeMaster 1000 ucId mcId) [0,500..10000]
 394
 395
 396 selectNgramsByNodeMaster :: Int -> UserCorpusId -> MasterCorpusId -> Int -> Cmd err [(NodeId, Text)]
 397 selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
 398                                queryNgramsByNodeMaster'
 399                                  ( ucId
 400                                  , ngramsTypeId NgramsTerms
 401                                  , nodeTypeId   NodeDocument
 402                                  , p
 403                                  , nodeTypeId   NodeDocument
 404                                  , p
 405                                  , n
 406                                  , mcId
 407                                  , nodeTypeId   NodeDocument
 408                                  , ngramsTypeId NgramsTerms
 409                                  )
 410
 411 -- | TODO fix node_node_ngrams relation
 412 queryNgramsByNodeMaster' :: DPS.Query
 413 queryNgramsByNodeMaster' = [sql|
 414   WITH nodesByNgramsUser AS (
 415
 416   SELECT n.id, ng.terms FROM nodes n
 417     JOIN nodes_nodes  nn  ON n.id = nn.node2_id
 418     JOIN node_node_ngrams nng ON nng.node2_id   = n.id
 419     JOIN ngrams       ng  ON nng.ngrams_id = ng.id
 420     WHERE nn.node1_id     = ?   -- UserCorpusId
 421       -- AND n.typename   = ?  -- NodeTypeId
 422       AND nng.ngrams_type = ? -- NgramsTypeId
 423       AND nn.category > 0
 424       AND node_pos(n.id,?) >= ?
 425       AND node_pos(n.id,?) <  ?
 426     GROUP BY n.id, ng.terms
 427
 428     ),
 429
 430   nodesByNgramsMaster AS (
 431
 432   SELECT n.id, ng.terms FROM nodes n TABLESAMPLE SYSTEM_ROWS(?)
 433     JOIN node_node_ngrams nng  ON n.id  = nng.node2_id
 434     JOIN ngrams       ng   ON ng.id = nng.ngrams_id
 435
 436     WHERE n.parent_id  = ?     -- Master Corpus NodeTypeId
 437       AND n.typename   = ?     -- NodeTypeId
 438       AND nng.ngrams_type = ? -- NgramsTypeId
 439     GROUP BY n.id, ng.terms
 440     )
 441
 442   SELECT m.id, m.terms FROM nodesByNgramsMaster m
 443     RIGHT JOIN nodesByNgramsUser u ON u.id = m.id
 444   |]
 445
 446