]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Flow/Utils.hs
Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantex...
[gargantext.git] / src / Gargantext / Database / Flow / Utils.hs
1 {-|
2 Module : Gargantext.Database.Flow.Utils
3 Description : Database Flow
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 {-# LANGUAGE NoImplicitPrelude #-}
13 {-# LANGUAGE OverloadedStrings #-}
14 {-# LANGUAGE RankNTypes #-}
15
16 module Gargantext.Database.Flow.Utils
17 where
18
19 import Data.Map (Map)
20 import qualified Data.Map as DM
21 import Gargantext.Prelude
22 import Gargantext.Database.Schema.Ngrams
23 import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata)
24 import Gargantext.Database.Utils (Cmd)
25 import Gargantext.Database.Schema.NodeNodeNgrams
26 import Gargantext.Database.Types.Node
27
28 toMaps :: Hyperdata a
29 => (a -> Map (NgramsT Ngrams) Int)
30 -> [Node a]
31 -> Map (NgramsT Ngrams) (Map NodeId Int)
32 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
33 where
34 ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
35
36 mapNodeIdNgrams :: Hyperdata a
37 => [DocumentIdWithNgrams a]
38 -> Map (NgramsT Ngrams) (Map NodeId Int)
39 mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
40 where
41 xs = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
42 n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
43
44
45 documentIdWithNgrams :: Hyperdata a
46 => (a -> Map (NgramsT Ngrams) Int)
47 -> [DocumentWithId a]
48 -> [DocumentIdWithNgrams a]
49 documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
50
51
52 data DocumentWithId a =
53 DocumentWithId { documentId :: NodeId
54 , documentData :: a
55 } deriving (Show)
56
57
58 data DocumentIdWithNgrams a =
59 DocumentIdWithNgrams
60 { documentWithId :: DocumentWithId a
61 , document_ngrams :: Map (NgramsT Ngrams) Int
62 } deriving (Show)
63
64
65 docNgrams2nodeNodeNgrams :: CorpusId
66 -> DocNgrams
67 -> NodeNodeNgrams
68 docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
69 NodeNodeNgrams cId d n nt w
70
71 data DocNgrams = DocNgrams { dn_doc_id :: DocId
72 , dn_ngrams_id :: Int
73 , dn_ngrams_type :: NgramsTypeId
74 , dn_weight :: Double
75 }
76
77 insertDocNgramsOn :: CorpusId
78 -> [DocNgrams]
79 -> Cmd err Int
80 insertDocNgramsOn cId dn =
81 insertNodeNodeNgrams
82 $ (map (docNgrams2nodeNodeNgrams cId) dn)
83
84 insertDocNgrams :: CorpusId
85 -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
86 -> Cmd err Int
87 insertDocNgrams cId m =
88 insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
89 | (ng, t2n2i) <- DM.toList m
90 , (t, n2i) <- DM.toList t2n2i
91 , (n, i) <- DM.toList n2i
92 ]
93