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
  14
  15 module Gargantext.Database.Action.Metrics
  16   where
  17
  18 import Data.Map (Map)
  19 import qualified Data.Map    as Map
  20 import Data.Text (Text)
  21
  22 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType)
  23 import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
  24 import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
  25 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  26 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
  27 import Gargantext.Database.Admin.Config (userMaster)
  28 import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
  29 import Gargantext.Database.Query.Table.Node (defaultList)
  30 import Gargantext.Database.Query.Table.Node.Select
  31 import Gargantext.Prelude
  32 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
  33
  34 getMetrics :: FlowCmdM env err m
  35             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
  36             -> m (Map Text (ListType, Maybe Text), [Scored Text])
  37 getMetrics cId maybeListId tabType maybeLimit = do
  38   (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
  39   pure (ngs, scored myCooc)
  40
  41
  42 getNgramsCooc :: (FlowCmdM env err m)
  43             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
  44             -> m ( Map Text (ListType, Maybe Text)
  45                  , Map Text (Maybe RootTerm)
  46                  , Map (Text, Text) Int
  47                  )
  48 getNgramsCooc cId maybeListId tabType maybeLimit = do
  49   (ngs', ngs) <- getNgrams cId maybeListId tabType
  50
  51   let
  52     take' Nothing  xs = xs
  53     take' (Just n) xs = take n xs
  54
  55   lId  <- defaultList cId
  56   lIds <- selectNodesWithUsername NodeList userMaster
  57
  58   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal True)
  59                             <$> groupNodesByNgrams ngs
  60                             <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) (ngramsTypeFromTabType tabType)
  61                                                              (take' maybeLimit $ Map.keys ngs)
  62   pure $ (ngs', ngs, myCooc)
  63
  64
  65
  66 getNgrams :: (FlowCmdM env err m)
  67             => CorpusId -> Maybe ListId -> TabType
  68             -> m (Map Text (ListType, Maybe Text), Map Text (Maybe RootTerm))
  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 = Map.unions $ map (\t -> filterListWithRoot t lists)
  77                              [MapTerm, StopTerm, CandidateTerm]
  78   pure (lists, maybeSyn)
  79