TFICF.hs

{-|
Module      : Gargantext.Database.Metrics.TFICF
Description : Ngram connection to the Database
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

TFICF, generalization of TFIDF

-}

{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE QuasiQuotes            #-}
{-# LANGUAGE RankNTypes        #-}

module Gargantext.Database.Metrics.TFICF where

import Database.PostgreSQL.Simple.SqlQQ (sql)
import qualified Database.PostgreSQL.Simple as DPS

import Safe (headMay)
import Gargantext.Text.Metrics.TFICF -- (tficf)
import Gargantext.Prelude
import Gargantext.Core.Types.Individu (UsernameMaster)
import Gargantext.Database.Utils (Cmd, runPGSQuery)
import Gargantext.Database.Types.Node (ListId, CorpusId, NodeType(..))
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Schema.Ngrams (NgramsId, NgramsTerms, NgramsType, ngramsTypeId)

type OccGlobal = Double
type OccCorpus = Double


getTficf :: UsernameMaster -> CorpusId -> ListId -> NgramsType
          -> Cmd err [Tficf]
getTficf u cId lId ngType = do
  g   <- getTficfGlobal u
  c   <- getTficfCorpus cId
  ngs <- getTficfNgrams u cId lId ngType

  pure $ map (\(nId, nTerms, wm, wn)
        -> Tficf nId nTerms
                 (tficf (TficfCorpus   wn (fromIntegral c))
                        (TficfLanguage wm (fromIntegral g))
                  )
              ) ngs

getTficfGlobal :: UsernameMaster -> Cmd err Int
getTficfGlobal u = maybe 0 identity <$> headMay
                <$> map (\(DPS.Only n) -> n )
                <$> runPGSQuery q p
  where
    p = (u, nodeTypeId NodeDocument)
    q = [sql| SELECT count(*) from nodes n
              JOIN auth_user a ON a.id = n.user_id
              WHERE
              a.username = ?
              AND n.typename = ?
  |]

getTficfCorpus :: CorpusId -> Cmd err Int
getTficfCorpus cId = maybe 0 identity <$> headMay
                  <$> map (\(DPS.Only n) -> n )
                  <$> runPGSQuery q p
  where
    p = (cId, nodeTypeId NodeDocument)
    q = [sql| WITH input(corpusId, typename) AS ((VALUES(?::"int4",?::"int4")))
              SELECT count(*) from nodes_nodes AS nn
              JOIN nodes AS n ON n.id = nn.node2_id
              JOIN input ON nn.node1_id = input.corpusId
              WHERE n.typename = input.typename;
  |]



getTficfNgrams :: UsernameMaster -> CorpusId -> ListId -> NgramsType
             -> Cmd err [(NgramsId, NgramsTerms, OccGlobal, OccCorpus)]
getTficfNgrams u cId lId ngType = runPGSQuery queryTficf p
  where
    p = (u, nodeTypeId NodeList, nodeTypeId NodeDocument, ngramsTypeId ngType, cId, lId)


queryTficf :: DPS.Query
queryTficf = [sql|
-- TODO add CTE for groups
WITH input(masterUsername,typenameList,typenameDoc,ngramsTypeId,corpusId,listId) 
  AS ((VALUES(?::"text", ? :: "int4", ?::"int4", ?::"int4",?::"int4",?::"int4"))),
  -- AS ((VALUES('gargantua'::"text", 5 :: "int4", 4::"int4", 4::"int4",1018::"int4",1019::"int4"))),

list_master AS (
SELECT n.id,n.name,n.user_id from nodes n
JOIN input       ON n.typename = input.typenameList
JOIN auth_user a ON a.id       = n.user_id
WHERE
a.username = input.masterUsername
),

ngrams_master AS (
SELECT ng.id, ng.terms, SUM(nng2.weight) AS weight FROM nodes_ngrams nng
JOIN list_master       ON list_master.id       = nng.node_id
JOIN nodes_ngrams nng2 ON nng2.ngrams_id = nng.ngrams_id
JOIN nodes        n   ON n.id          = nng2.node_id
JOIN input            ON input.typenameDoc = n.typename
JOIN ngrams       ng  ON ng.id         = nng2.ngrams_id
WHERE
 nng.ngrams_type = input.ngramsTypeId
-- AND n.hyperdata -> 'lang' = 'en'
GROUP BY ng.id,ng.terms
),

ngrams_user AS (
SELECT ng.id, ng.terms, SUM(nng2.weight) AS weight
FROM nodes_ngrams nng
JOIN list_master       ON list_master.id        = nng.node_id

JOIN nodes_ngrams nng2 ON nng2.ngrams_id = nng.ngrams_id
JOIN nodes_nodes  nn   ON nn.node2_id    = nng2.node_id

JOIN ngrams       ng   ON ng.id          = nng2.ngrams_id
JOIN input             ON nn.node1_id    = input.corpusId

WHERE
     nng.ngrams_type = input.ngramsTypeId
-- AND n.hyperdata -> 'lang' = 'en'
GROUP BY ng.id,ng.terms
)


SELECT nu.id,nu.terms,SUM(nm.weight) wm,SUM(nu.weight) wu
FROM ngrams_user nu
JOIN ngrams_master nm ON nm.id = nu.id
WHERE
nm.weight > 1
AND
nu.weight > 1
GROUP BY nu.id,nu.terms
--ORDER BY wm DESC
--LIMIT 1000

  |]