[FEAT] Backend NLP French tested
[gargantext.git] / src / Gargantext / Core / Viz / Graph / API.hs
index 46ae7d25798a9129f5bf077a2c2aadb509744117..adfc5ef5701d6f77b44a0a156dd7c11a08cca8a3 100644 (file)
@@ -9,6 +9,7 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
 {-# LANGUAGE TypeOperators     #-}
 
@@ -94,16 +95,18 @@ getGraph _uId nId = do
   mcId <- getClosestParentIdByType nId NodeCorpus
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
-  printDebug "[getGraph] getting list for cId" cId
+  -- printDebug "[getGraph] getting list for cId" cId
   listId <- defaultList cId
-  repo <- getRepo' [listId]
+  repo <- getRepo [listId]
 
   -- TODO Distance in Graph params
   case graph of
     Nothing     -> do
-        let defaultMetric = Order1
-        graph' <- computeGraph cId Spinglass (withMetric defaultMetric) NgramsTerms repo
-        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric
+        let defaultMetric          = Order1
+        let defaultPartitionMethod = Spinglass
+        let defaultEdgesStrength   = Strong
+        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength NgramsTerms repo
+        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
         let
           graph'' = set graph_metadata (Just mt) graph'
           hg = HyperdataGraphAPI graph'' camera
@@ -121,9 +124,10 @@ recomputeGraph :: FlowCmdM env err m
                -> NodeId
                -> PartitionMethod
                -> Maybe GraphMetric
+               -> Maybe Strength
                -> Bool
                -> m Graph
-recomputeGraph _uId nId method maybeDistance force = do
+recomputeGraph _uId nId method maybeDistance maybeStrength force = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -137,22 +141,28 @@ recomputeGraph _uId nId method maybeDistance force = do
                    Nothing -> withMetric Order1
                    Just m  -> withMetric m
 
+    strength = case maybeStrength of
+                   Nothing -> case graph ^? _Just . graph_metadata . _Just . gm_edgesStrength of
+                        Nothing  -> Strong
+                        Just  mr -> fromMaybe Strong mr
+                   Just r  -> r
+
   mcId <- getClosestParentIdByType nId NodeCorpus
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
   listId  <- defaultList cId
-  repo <- getRepo' [listId]
+  repo <- getRepo [listId]
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
-        g <- computeGraph cId method similarity NgramsTerms repo
+        !g <- computeGraph cId method similarity strength NgramsTerms repo
         let g' = set graph_metadata mt g
-        _ <- updateHyperdata nId (HyperdataGraph (Just g') camera)
+        _nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
         pure g'
 
   case graph of
     Nothing     -> do
-      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance)
+      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance) strength
       g <- computeG $ Just mt
       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
     Just graph' -> if (listVersion == Just v) && (not force)
@@ -166,34 +176,28 @@ computeGraph :: FlowCmdM env err m
              => CorpusId
              -> PartitionMethod
              -> Distance
+             -> Strength
              -> NgramsType
              -> NodeListStory
              -> m Graph
-computeGraph cId method d nt repo = do
+computeGraph cId method d strength nt repo = do
   lId  <- defaultList cId
   lIds <- selectNodesWithUsername NodeList userMaster
-
-  let ngs = filterListWithRoot MapTerm
+  let ngs = filterListWithRoot [MapTerm]
           $ mapTermListRoot [lId] nt repo
 
-  myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
-         -- <$> HashMap.filterWithKey (\(x,y) _ -> x /= y)
-         -- <$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
+  !myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
          <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
          <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
 
-  -- printDebug "myCooc" myCooc
-  -- saveAsFileDebug "debug/my-cooc" myCooc
-
-  listNgrams <- getListNgrams [lId] nt
+  graph <- liftBase $ cooc2graphWith method d 0 strength myCooc
 
-  -- graph <- liftBase $ cooc2graphWith Confluence d 0 myCooc
-  -- graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
-  graph <- liftBase $ cooc2graphWith method d 0 myCooc
-  -- saveAsFileDebug "debug/graph" graph
+  --listNgrams <- getListNgrams [lId] nt
+  --let graph' = mergeGraphNgrams graph (Just listNgrams)
+  -- saveAsFileDebug "/tmp/graphWithNodes" graph'
 
-  pure $ mergeGraphNgrams graph (Just listNgrams)
+  pure graph
 
 
 defaultGraphMetadata :: HasNodeError err
@@ -201,23 +205,24 @@ defaultGraphMetadata :: HasNodeError err
                      -> Text
                      -> NodeListStory
                      -> GraphMetric
+                     -> Strength
                      -> Cmd err GraphMetadata
-defaultGraphMetadata cId t repo gm = do
+defaultGraphMetadata cId t repo gm str = do
   lId  <- defaultList cId
 
-  pure $ GraphMetadata {
-      _gm_title = t
-    , _gm_metric = gm
-    , _gm_corpusId = [cId]
-    , _gm_legend = [
-          LegendField 1 "#FFF" "Cluster1"
-        , LegendField 2 "#FFF" "Cluster2"
-        , LegendField 3 "#FFF" "Cluster3"
-        , LegendField 4 "#FFF" "Cluster4"
-        ]
-      , _gm_list = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
-      , _gm_startForceAtlas = True
-    }
+  pure $ GraphMetadata { _gm_title         = t
+                       , _gm_metric        = gm
+                       , _gm_edgesStrength = Just str
+                       , _gm_corpusId      = [cId]
+                       , _gm_legend = [
+                             LegendField 1 "#FFF" "Cluster1"
+                           , LegendField 2 "#FFF" "Cluster2"
+                           , LegendField 3 "#FFF" "Cluster3"
+                           , LegendField 4 "#FFF" "Cluster4"
+                           ]
+                       , _gm_list  = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
+                       , _gm_startForceAtlas = True
+                       }
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 
 ------------------------------------------------------------
@@ -247,7 +252,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing False
+  _g <- recomputeGraph u n Spinglass Nothing Nothing False
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -290,9 +295,9 @@ graphVersions n nId = do
                       else panic "[G.V.G.API] list not found after iterations"
 
     Just listId -> do
-      repo <- getRepo' [listId]
+      repo <- getRepo [listId]
       let v = repo ^. unNodeStory . at listId . _Just . a_version
-      printDebug "graphVersions" v
+      -- printDebug "graphVersions" v
 
       pure $ GraphVersions { gv_graph = listVersion
                            , gv_repo = v }
@@ -302,7 +307,7 @@ recomputeVersions :: FlowCmdM env err m
                   => UserId
                   -> NodeId
                   -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing False
 
 ------------------------------------------------------------
 graphClone :: UserId