src/Gargantext/Database/Action/Metrics.hs

   1 {-|
   2 Module      : Gargantext.Database.Metrics
   3 Description : Get Metrics from Storage (Database like)
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Node API
  11 -}
  12
  13 module Gargantext.Database.Action.Metrics
  14   where
  15
  16 import Data.HashMap.Strict (HashMap)
  17 import Data.Vector (Vector)
  18 import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
  19 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm)
  20 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
  21 import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
  22 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  23 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
  24 import Gargantext.Database.Admin.Config (userMaster)
  25 import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
  26 import Gargantext.Database.Query.Table.Node (defaultList)
  27 import Gargantext.Database.Query.Table.Node.Select
  28 import Gargantext.Prelude
  29 import qualified Data.HashMap.Strict as HM
  30
  31 getMetrics :: FlowCmdM env err m
  32             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
  33             -> m (HashMap NgramsTerm (ListType, Maybe NgramsTerm), Vector (Scored NgramsTerm))
  34 getMetrics cId maybeListId tabType maybeLimit = do
  35   (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
  36   -- TODO HashMap
  37   pure (ngs, scored myCooc)
  38
  39
  40 getNgramsCooc :: (FlowCmdM env err m)
  41             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
  42             -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
  43                  , HashMap NgramsTerm (Maybe RootTerm)
  44                  , HashMap (NgramsTerm, NgramsTerm) Int
  45                  )
  46 getNgramsCooc cId maybeListId tabType maybeLimit = do
  47   (ngs', ngs) <- getNgrams cId maybeListId tabType
  48
  49   let
  50     take' Nothing  xs = xs
  51     take' (Just n) xs = take n xs
  52
  53   lId  <- defaultList cId
  54   lIds <- selectNodesWithUsername NodeList userMaster
  55
  56   myCooc <- HM.filter (>1) <$> getCoocByNgrams (Diagonal True)
  57                            <$> groupNodesByNgrams ngs
  58                            <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) (ngramsTypeFromTabType tabType)
  59                                                             (take' maybeLimit $ HM.keys ngs)
  60   pure $ (ngs', ngs, myCooc)
  61
  62
  63
  64 getNgrams :: (FlowCmdM env err m)
  65             => CorpusId -> Maybe ListId -> TabType
  66             -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
  67                  , HashMap NgramsTerm (Maybe RootTerm)
  68                  )
  69 getNgrams cId maybeListId tabType = do
  70
  71   lId <- case maybeListId of
  72     Nothing   -> defaultList cId
  73     Just lId' -> pure lId'
  74
  75   lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo
  76   let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
  77                              [MapTerm, StopTerm, CandidateTerm]
  78   pure (lists, maybeSyn)
  79