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