]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Action/Metrics/Lists.hs
[FEAT] SocialList Map Text ScoresParent to Map Text Children
[gargantext.git] / 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 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
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 Prelude hiding (null, id, map, sum)
23 import qualified Data.Map as Map
24 import qualified Data.Vector as Vec
25
26 import qualified Gargantext.Database.Action.Metrics as Metrics
27 import Gargantext.API.Ngrams.Types (TabType(..))
28 import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
29 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
30 import Gargantext.Prelude hiding (sum, head)
31 import Gargantext.Core.Text.Metrics (Scored(..))
32
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 Int
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 $ Map.lookup t m
54 errorMsg = "API.Node.metrics: key absent"
55
56 {-
57 _ <- Learn.grid 100 110 metrics' metrics'
58 --}
59 pure $ Map.fromListWith (<>) metrics
60