[GRAPH] API connected (needs bridgeness).

src/Gargantext/API/Node.hs

@@ -262,16 +262,14 @@ graphAPI nId = do
                                      , LegendField 5 "#FFF" "Energy / Environment"
                                      ]
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
-  
-  myCooc <- getCoocByDocDev nId <$> defaultList (maybe (panic "no parentId") identity $ _node_parentId nodeGraph)
-  myCooc' <- myCooc
-  --{-
+  let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
+  lId <- defaultList cId
+  myCooc <- getCoocByDocDev cId lId
   liftIO $ set graph_metadata (Just metadata)
-        <$> cooc2graph myCooc'
+        <$> 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

src/Gargantext/Database/Flow.hs

@@ -93,7 +93,7 @@ flowInsertAnnuaire name children = do
   (userId, _, userCorpusId) <- subFlowAnnuaire userArbitrary name
   _ <- add userCorpusId (map reId ids)
 
-  printDebug "AnnuaireID" userCorpusId
+ --printDebug "AnnuaireID" userCorpusId
 
   pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
 
@@ -102,11 +102,11 @@ flowCorpus' :: HasNodeError err
             => NodeType -> [HyperdataDocument]
             -> ([ReturnId], UserId, CorpusId, UserId, CorpusId)
             -> Cmd err CorpusId
-flowCorpus' NodeCorpus hyperdataDocuments (ids,masterUserId,masterCorpusId, userId,userCorpusId) = do
+flowCorpus' NodeCorpus hyperdataDocuments (ids,_masterUserId,_masterCorpusId, userId,userCorpusId) = do
 --------------------------------------------------
   -- List Ngrams Flow
-  userListId <- flowListUser userId userCorpusId 3000
-  printDebug "Working on User ListId : " userListId
+  --userListId <- flowListUser userId userCorpusId 500
+  --printDebug "Working on User ListId : " userListId
 
   let documentsWithId = mergeData (toInserted ids) (toInsert hyperdataDocuments)
   -- printDebug "documentsWithId" documentsWithId
@@ -120,8 +120,8 @@ flowCorpus' NodeCorpus hyperdataDocuments (ids,masterUserId,masterCorpusId, user
   -- printDebug "inserted ngrams" indexedNgrams
   _             <- insertToNodeNgrams indexedNgrams
 
-  listId2    <- flowList masterUserId masterCorpusId indexedNgrams
-  printDebug "Working on ListId : " listId2
+  --listId2    <- flowList masterUserId masterCorpusId indexedNgrams
+  --printDebug "Working on ListId : " listId2
   --}
 --------------------------------------------------
   _ <- mkDashboard userCorpusId userId
@@ -170,8 +170,8 @@ subFlowCorpus username cName = do
 
   corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
 
-  printDebug "(username, userId, rootId, corpusId)"
-              (username, userId, rootId, corpusId)
+  --printDebug "(username, userId, rootId, corpusId)"
+  --            (username, userId, rootId, corpusId)
   pure (userId, rootId, corpusId)
 
 
@@ -197,8 +197,8 @@ subFlowAnnuaire username _cName = do
 
   corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
 
-  printDebug "(username, userId, rootId, corpusId)"
-              (username, userId, rootId, corpusId)
+  --printDebug "(username, userId, rootId, corpusId)"
+  --            (username, userId, rootId, corpusId)
   pure (userId, rootId, corpusId)
 
 ------------------------------------------------------------------------
@@ -267,7 +267,7 @@ mapNodeIdNgrams = DM.unionsWith (DM.unionWith (DM.unionWith (+))) . fmap f
 ------------------------------------------------------------------------
 flowList :: HasNodeError err => UserId -> CorpusId
          -> Map NgramsIndexed (Map NgramsType (Map NodeId Int)) -> Cmd err ListId
-flowList uId cId ngs = do
+flowList uId cId _ngs = do
   -- printDebug "ngs:" ngs
   lId <- getOrMkList cId uId
   --printDebug "ngs" (DM.keys ngs)
@@ -277,8 +277,8 @@ flowList uId cId ngs = do
   -- _ <- insertGroups lId groupEd
 
 -- compute Candidate / Map
-  is <- insertLists lId $ ngrams2list ngs
-  printDebug "listNgrams inserted :" is
+  --is <- insertLists lId $ ngrams2list ngs
+  --printDebug "listNgrams inserted :" is
 
   pure lId
 

src/Gargantext/Text/Flow.hs

@@ -25,10 +25,10 @@ import Data.Text.IO (readFile)
 
 import Data.Map.Strict (Map)
 import Data.Maybe (catMaybes)
-import qualified Data.Set as DS
+--import qualified Data.Set as DS
 import Data.Text (Text)
 
-import qualified Data.Array.Accelerate as A
+--import qualified Data.Array.Accelerate as A
 import qualified Data.Map.Strict as M
 ----------------------------------------------
 import Database.PostgreSQL.Simple (Connection)
@@ -50,7 +50,7 @@ import Gargantext.Core.Types (CorpusId)
 
 import Gargantext.Text.Parsers.CSV
 
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain, l_community_id)
+import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 
 {-
   ____                             _            _
@@ -105,26 +105,26 @@ textFlow' termType contexts = do
   -- TermsType = Mono | Multi | MonoMulti
   -- myterms # filter (\t -> not . elem t stopList)
   --         # groupBy (Stem|GroupList|Ontology)
-  printDebug "terms" myterms
-  printDebug "myterms" (sum $ map length myterms)
+  --printDebug "terms" myterms
+  --printDebug "myterms" (sum $ map length myterms)
 
   -- Bulding the map list
   -- compute copresences of terms, i.e. cooccurrences of terms in same context of text
   -- Cooc = Map (Term, Term) Int
   let myCooc1 = cooc myterms
-  printDebug "myCooc1 size" (M.size myCooc1)
+  --printDebug "myCooc1 size" (M.size myCooc1)
 
   -- Remove Apax: appears one time only => lighting the matrix
   let myCooc2 = M.filter (>0) myCooc1
-  printDebug "myCooc2 size" (M.size myCooc2)
-  printDebug "myCooc2" myCooc2
+  --printDebug "myCooc2 size" (M.size myCooc2)
+  --printDebug "myCooc2" myCooc2
   g <- cooc2graph myCooc2
   pure g
 
 -- TODO use Text only here instead of [Text]
 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 )
                                           (InclusionSize  500 )
@@ -132,39 +132,41 @@ cooc2graph myCooc = do
                                           (Clusters         3 )
                                           (DefaultValue     0 )
                            ) myCooc
-  printDebug "myCooc3 size" $ M.size myCooc3
-  printDebug "myCooc3" myCooc3
+  --printDebug "myCooc3 size" $ M.size myCooc3
+  --printDebug "myCooc3" myCooc3
 
   -- Cooc -> Matrix
   let (ti, _) = createIndices myCooc3
-  printDebug "ti size" $ M.size ti
-  printDebug "ti" ti
+  --printDebug "ti size" $ M.size ti
+  --printDebug "ti" ti
 
   let myCooc4 = toIndex ti myCooc3
-  printDebug "myCooc4 size" $ M.size myCooc4
-  printDebug "myCooc4" myCooc4
+  --printDebug "myCooc4 size" $ M.size myCooc4
+  --printDebug "myCooc4" myCooc4
 
   let matCooc = map2mat (0) (M.size ti) myCooc4
-  printDebug "matCooc shape" $ A.arrayShape matCooc
-  printDebug "matCooc" matCooc
+  --printDebug "matCooc shape" $ A.arrayShape matCooc
+  --printDebug "matCooc" matCooc
 
   -- Matrix -> Clustering
   let distanceMat = measureConditional matCooc
   --let distanceMat = distributional matCooc
-  printDebug "distanceMat shape" $ A.arrayShape distanceMat
-  printDebug "distanceMat" distanceMat
+  --printDebug "distanceMat shape" $ A.arrayShape distanceMat
+  --printDebug "distanceMat" distanceMat
 
   --let distanceMap = M.filter (>0) $ mat2map distanceMat
   let distanceMap = M.map (\_ -> 1) $ M.filter (>0) $ mat2map distanceMat
-  printDebug "distanceMap size" $ M.size distanceMap
-  printDebug "distanceMap" distanceMap
+  --printDebug "distanceMap size" $ M.size distanceMap
+  --printDebug "distanceMap" distanceMap
 
 --  let distance = fromIndex fi distanceMap
---  printDebug "distance" $ M.size distance
-
-  partitions <- cLouvain distanceMap
+  --printDebug "distance" $ M.size distance
+  
+  partitions <- case M.size distanceMap > 0 of
+                  True  -> cLouvain distanceMap
+                  False -> panic "Text.Flow: DistanceMap is empty"
 -- Building : -> Graph -> JSON
-  printDebug "partitions" $ DS.size $ DS.fromList $ map (l_community_id) partitions
+  --printDebug "partitions" $ DS.size $ DS.fromList $ map (l_community_id) partitions
   --printDebug "partitions" partitions
   pure $ data2graph (M.toList ti) myCooc4 distanceMap partitions