[GRAPH FLOW] needs some parameterization.

src/Gargantext/API/Ngrams.hs

@@ -894,23 +894,6 @@ getNgramsTableMap nodeId ngramsType = do
   pure $ Versioned (repo ^. r_version)
                    (repo ^. r_state . at ngramsType . _Just . at nodeId . _Just)
 
--- UNUSED
-_getListNgrams :: RepoCmdM env err m
-                => [NodeId] -> NgramsType -> m (Versioned ListNgrams)
-_getListNgrams nodeIds ngramsType = do
-  v <- view repoVar
-  repo <- liftIO $ readMVar v
-
-  let
-    ngramsMap = repo ^. r_state . at ngramsType . _Just
-
-    ngrams =
-      Map.unionsWith mergeNgramsElement
-        [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
-
-  pure $ Versioned (repo ^. r_version)
-       $ NgramsTable (ngramsElementFromRepo <$> Map.toList ngrams)
-
 type MinSize = Int
 type MaxSize = Int
 

src/Gargantext/API/Ngrams/Tools.hs

+{-|
+Module      : Gargantext.API.Ngrams.Tools
+Description : Tools to manage Ngrams Elements (from the API)
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+
+module Gargantext.API.Ngrams.Tools
+  where
+
+import Control.Concurrent
+import Control.Lens (_Just, (^.), at, view)
+import Control.Monad.Reader
+import Data.Map.Strict (Map)
+import Data.Set (Set)
+import Data.Text (Text)
+import Data.Validity
+import Gargantext.API.Ngrams
+import Gargantext.Core.Types (ListType(..), NodeId, ListId)
+import Gargantext.Database.Schema.Ngrams (NgramsType)
+import Gargantext.Prelude
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+
+type RootTerm = Text
+
+getListNgrams :: RepoCmdM env err m
+               => [ListId] -> NgramsType
+               -> m (Map Text (ListType, (Maybe Text)))
+getListNgrams nodeIds ngramsType = do
+  v    <- view repoVar
+  repo <- liftIO $ readMVar v
+
+  let
+    ngramsMap = repo ^. r_state . at ngramsType . _Just
+
+    ngrams    = Map.unionsWith mergeNgramsElement
+              [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
+
+    mapTermListRoot = Map.fromList
+                    [(t, (_nre_list nre, _nre_root nre))
+                    | (t, nre) <- Map.toList ngrams
+                    ]
+
+  pure mapTermListRoot
+
+
+filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
+                      -> Map Text (Maybe RootTerm)
+filterListWithRoot lt m = Map.fromList
+                    $ map (\(t,(_,r)) -> (t,r))
+                    $ filter isGraphTerm (Map.toList m)
+  where
+    isGraphTerm (_t,(l, maybeRoot)) = case maybeRoot of
+      Nothing -> l == lt
+      Just  r -> case Map.lookup r m of
+        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r
+        Just  (l',_) -> l' == lt
+
+
+groupNodesByNgrams :: Map Text (Maybe RootTerm)
+                   -> Map Text (Set NodeId)
+                   -> Map Text (Set NodeId)
+groupNodesByNgrams syn occs = Map.fromListWith (<>) occs'
+  where
+    occs' = map toSyn (Map.toList occs)
+    toSyn (t,ns) = case Map.lookup t syn of
+      Nothing -> panic $ "Garg.API.Ngrams.Tools: groupNodesByNgrams, unknown key: " <> t
+      Just  r -> case r of
+        Nothing  -> (t, ns)
+        Just  r' -> (r',ns)
+
+
+getCoocByNgrams :: Map Text (Set NodeId) -> Map (Text, Text) Int
+getCoocByNgrams m =
+  Map.fromList [((t1,t2)
+                ,maybe 0 Set.size $ Set.intersection
+                                 <$> Map.lookup t1 m
+                                 <*> Map.lookup t2 m
+                ) | (t1,t2) <- listToCombi identity $ Map.keys m
+               ]
+
+

src/Gargantext/API/Node.hs

@@ -10,7 +10,7 @@ Portability : POSIX
 Node API
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveGeneric      #-}
@@ -21,7 +21,6 @@ Node API
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
 
--------------------------------------------------------------------
 module Gargantext.API.Node
   ( module Gargantext.API.Node
   , HyperdataAny(..)
@@ -32,47 +31,41 @@ module Gargantext.API.Node
   , HyperdataDocument(..)
   , HyperdataDocumentV3(..)
   ) where
--------------------------------------------------------------------
+
 import Control.Lens (prism', set)
-import Control.Monad.IO.Class (liftIO)
 import Control.Monad ((>>))
---import System.IO (putStrLn, readFile)
-
-import qualified Data.Map as Map
+import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, ToJSON)
-import Data.Text (Text())
 import Data.Swagger
+import Data.Text (Text())
 import Data.Time (UTCTime)
-
+import Debug.Trace (trace)
 import GHC.Generics (Generic)
-import Servant
-
 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgrams, HasRepo)
-import Gargantext.Prelude
-import Gargantext.Database.Types.Node
-import Gargantext.Database.Utils -- (Cmd, CmdM)
-import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, NodeError(..), HasNodeError(..))
-import Gargantext.Database.Node.Children (getChildren)
-import qualified Gargantext.Database.Node.Update as U (update, Update(..))
+import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
+import Gargantext.Core.Types (Offset, Limit, ListType(..))
+import Gargantext.Core.Types.Main (Tree, NodeTree)
 import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),FacetChart,runViewAuthorsDoc)
-import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
-import Gargantext.Database.Metrics.Count (getNgramsByNode)
+import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
+import Gargantext.Database.Node.Children (getChildren)
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, NodeError(..), HasNodeError(..))
 import Gargantext.Database.Schema.Node (defaultList)
 import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
-import Gargantext.Database.Schema.Ngrams (NgramsType(..))
-import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
-import Gargantext.Text.Metrics.Count (coocOn)
--- Graph
+import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
+import Gargantext.Database.Types.Node
+import Gargantext.Database.Types.Node (CorpusId, ContactId)
+import Gargantext.Database.Utils -- (Cmd, CmdM)
+import Gargantext.Prelude
 import Gargantext.Text.Flow (cooc2graph)
 import Gargantext.Viz.Graph hiding (Node)-- (Graph(_graph_metadata),LegendField(..), GraphMetadata(..),readGraphFromJson,defaultGraph)
--- import Gargantext.Core (Lang(..))
-import Gargantext.Core.Types (Offset, Limit)
-import Gargantext.Core.Types.Main (Tree, NodeTree)
-import Gargantext.Database.Types.Node (CorpusId, ContactId)
--- import Gargantext.Text.Terms (TermType(..))
-
+import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Data.Map as Map
+import qualified Gargantext.Database.Node.Update as U (update, Update(..))
+
 
 type GargServer api =
   forall env m.
@@ -281,7 +274,6 @@ type GraphAPI   = Get '[JSON] Graph
 
 graphAPI :: NodeId -> GargServer GraphAPI
 graphAPI nId = do
-
   nodeGraph <- getNode nId HyperdataGraph
 
   let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
@@ -290,17 +282,16 @@ graphAPI nId = do
                                      ]
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
   let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
-  _lId <- defaultList cId
-  -- lId' <- listsWith masterUser
-  --myCooc <- getCoocByDocDev cId lId -- (lid' <> [lId])
-  myCooc <- Map.filter (>2) <$> coocOn identity <$> getNgramsByNode cId NgramsTerms
-  liftIO $ set graph_metadata (Just metadata) <$> cooc2graph myCooc
-        
-        -- <$> maybe defaultGraph identity
-        -- <$> readGraphFromJson "purescript-gargantext/dist/examples/imtNew.json"
-  -- t <- textFlow (Mono EN) (Contexts contextText)
-  -- liftIO $ liftIO $ pure $  maybe t identity maybeGraph
-  -- TODO what do we get about the node? to replace contextText
+  lId <- defaultList cId
+
+  ngs    <- filterListWithRoot GraphTerm <$> getListNgrams [lId] NgramsTerms
+
+  myCooc <- Map.filter (>1) <$> getCoocByNgrams
+                            <$> groupNodesByNgrams ngs
+                            <$> getNodesByNgramsOnlyUser cId NgramsTerms (Map.keys ngs)
+
+  liftIO $ trace (show myCooc) $ set graph_metadata (Just metadata) <$> cooc2graph myCooc
+
 
 instance HasNodeError ServantErr where
   _NodeError = prism' mk (const Nothing) -- $ panic "HasNodeError ServantErr: not a prism")
@@ -337,7 +328,7 @@ treeAPI = treeDB
 ------------------------------------------------------------------------
 -- | Check if the name is less than 255 char
 rename :: NodeId -> RenameNode -> Cmd err [Int]
-rename nId (RenameNode name) = U.update (U.Rename nId name)
+rename nId (RenameNode name') = U.update (U.Rename nId name')
 
 getTable :: NodeId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
@@ -361,7 +352,7 @@ getChart :: NodeId -> Maybe UTCTime -> Maybe UTCTime
 getChart _ _ _ = undefined -- TODO
 
 postNode :: HasNodeError err => UserId -> NodeId -> PostNode -> Cmd err [NodeId]
-postNode uId pId (PostNode name nt) = mkNodeWithParent nt (Just pId) uId name
+postNode uId pId (PostNode nodeName nt) = mkNodeWithParent nt (Just pId) uId nodeName
 
 putNode :: NodeId -> Cmd err Int
 putNode = undefined -- TODO

src/Gargantext/Database/Metrics/NgramsByNode.hs

@@ -137,18 +137,6 @@ getOccByNgramsOnly :: CorpusId -> NgramsType -> [Text]
 getOccByNgramsOnly cId nt ngs = Map.map Set.size
                              <$> getNodesByNgramsOnlyUser cId nt ngs
 
--- TODO add groups
-getCoocByNgramsOnly :: CorpusId -> NgramsType -> [Text]
-                    -> Cmd err (Map (Text,Text) Int)
-getCoocByNgramsOnly cId nt ngs = do
-  ngs' <- getNodesByNgramsOnlyUser cId nt ngs
-  pure $ Map.fromList [( (t1,t2)
-                       , maybe 0 Set.size $ Set.intersection
-                                         <$> Map.lookup t1 ngs'
-                                         <*> Map.lookup t2 ngs'
-                       )
-                      | (t1,t2) <- listToCombi identity $ Map.keys ngs']
-
 getNodesByNgramsOnlyUser :: CorpusId -> NgramsType -> [Text] -> Cmd err (Map Text (Set NodeId))
 getNodesByNgramsOnlyUser cId nt ngs = fromListWith (<>) <$> map (\(n,t) -> (t, Set.singleton n))
                                          <$> selectNgramsOnlyByNodeUser cId nt ngs

src/Gargantext/Text/Flow.hs

@@ -36,7 +36,7 @@ import Gargantext.Core.Types (CorpusId)
 --import Gargantext.Database.Types.Node
 import Gargantext.Prelude
 --import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
-import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
+--import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
 --import Gargantext.Text.Metrics.Count (coocOn)
 --import Gargantext.Text.Parsers.CSV
 --import Gargantext.Text.Terms (TermType, extractTerms)
@@ -120,21 +120,21 @@ cooc2graph :: (Map (Text, Text) Int) -> IO Graph
 cooc2graph myCooc = do
   --printDebug "myCooc" myCooc
   -- Filtering terms with inclusion/Exclusion and Specificity/Genericity scores
-  let myCooc3 = filterCooc ( FilterConfig (MapListSize    350 )
+{-  let myCooc3 = filterCooc ( FilterConfig (MapListSize    350 )
                                           (InclusionSize  500 )
                                           (SampleBins      10 )
                                           (Clusters         3 )
                                           (DefaultValue     0 )
                            ) myCooc
-  --printDebug "myCooc3 size" $ M.size myCooc3
+-}  --printDebug "myCooc3 size" $ M.size myCooc3
   --printDebug "myCooc3" myCooc3
 
   -- Cooc -> Matrix
-  let (ti, _) = createIndices myCooc3
+  let (ti, _) = createIndices myCooc
   --printDebug "ti size" $ M.size ti
   --printDebug "ti" ti
 
-  let myCooc4 = toIndex ti myCooc3
+  let myCooc4 = toIndex ti myCooc
   --printDebug "myCooc4 size" $ M.size myCooc4
   --printDebug "myCooc4" myCooc4