src/Gargantext/Database/Action/Metrics/Lists.hs

   1 {-|
   2 Module      : Gargantext.Database.Lists
   3 Description : Main requests of Node to the database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE ConstraintKinds        #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE TemplateHaskell        #-}
  18
  19 module Gargantext.Database.Action.Metrics.Lists
  20   where
  21
  22 import Gargantext.API.Ngrams.Types (TabType(..))
  23 import Gargantext.Core.Text.Metrics (Scored(..))
  24 import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
  25 import Gargantext.Core.Types.Query (Limit)
  26 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  27 import Gargantext.Prelude hiding (sum, head)
  28 import Prelude hiding (null, id, map, sum)
  29 import qualified Data.HashMap.Strict as HashMap
  30 import qualified Data.Map.Strict as Map
  31 import qualified Data.Vector as Vec
  32 import qualified Gargantext.Database.Action.Metrics as Metrics
  33 {-
  34 trainModel :: FlowCmdM env ServantErr m
  35              => Username -> m Score
  36 trainModel u = do
  37   rootId <- _node_id <$> getRoot u
  38   (id:ids)   <- getCorporaWithParentId rootId
  39   (s,_model) <- case length ids >0 of
  40         True  ->  grid 100 150 (getMetrics
  41         False -> panic "Gargantext.Database.Lists.trainModel : not enough corpora"
  42   --}
  43
  44
  45 getMetrics' :: FlowCmdM env err m
  46              => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
  47              -> m (Map.Map ListType [Vec.Vector Double])
  48 getMetrics' cId maybeListId tabType maybeLimit = do
  49   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
  50
  51   let
  52     metrics      = map (\(Scored t s1 s2) -> (listType t ngs', [Vec.fromList [s1,s2]])) scores
  53     listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
  54     errorMsg     = "API.Node.metrics: key absent"
  55
  56   {-
  57   _ <- Learn.grid 100 110 metrics' metrics'
  58   --}
  59   pure $ Map.fromListWith (<>) $ Vec.toList metrics