[FEAT] Graph Multipartite connected, need to change the node shape in Graph and tests
[gargantext.git] / src / Gargantext / Core / Text / List.hs
index dd9ef3201bf76d02fec7b5ae6ed464bc9ecdf4bc..fc9a32539605a919f0401f805576bf2c513a1a37 100644 (file)
@@ -34,7 +34,7 @@ import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.Metrics (scored', Scored(..), scored_speExc, scored_genInc, normalizeGlobal, normalizeLocal, scored_terms)
 import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getNodesByNgramsOnlyUser)
+import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, getContextsByNgramsOnlyUser)
 import Gargantext.Database.Action.Metrics.TFICF (getTficf_withSample)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (CmdM)
@@ -67,44 +67,47 @@ buildNgramsLists :: ( HasNodeStory env err m
                     , HasTreeError err
                     , HasNodeError err
                     )
-                 => GroupParams
-                 -> User
+                 => User
                  -> UserCorpusId
                  -> MasterCorpusId
+                 -> Maybe FlowSocialListWith
+                 -> GroupParams
                  -> m (Map NgramsType [NgramsElement])
-buildNgramsLists gp user uCid mCid = do
-  ngTerms     <- buildNgramsTermsList user uCid mCid gp (NgramsTerms, MapListSize 350)
-  othersTerms <- mapM (buildNgramsOthersList user uCid GroupIdentity)
-                      [ (Authors   , MapListSize 9)
-                      , (Sources   , MapListSize 9)
-                      , (Institutes, MapListSize 9)
+buildNgramsLists user uCid mCid mfslw gp = do
+  ngTerms     <- buildNgramsTermsList user uCid mCid mfslw gp (NgramsTerms, MapListSize 350)
+  othersTerms <- mapM (buildNgramsOthersList user uCid mfslw GroupIdentity)
+                      [ (Authors   , MapListSize 9, MaxListSize 1000)
+                      , (Sources   , MapListSize 9, MaxListSize 1000)
+                      , (Institutes, MapListSize 9, MaxListSize 1000)
                       ]
 
   pure $ Map.unions $ [ngTerms] <> othersTerms
 
 
 data MapListSize = MapListSize { unMapListSize :: !Int }
-
-buildNgramsOthersList ::( HasNodeError err
-                        , CmdM     env err m
-                        , HasNodeStory env err m
-                        , HasTreeError err
-                        )
-                        => User
-                        -> UserCorpusId
-                        -> GroupParams
-                        -> (NgramsType, MapListSize)
-                        -> m (Map NgramsType [NgramsElement])
-buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
-  allTerms  :: HashMap NgramsTerm (Set NodeId) <- getNodesByNgramsUser uCid nt
+data MaxListSize = MaxListSize { unMaxListSize :: !Int }
+
+buildNgramsOthersList :: ( HasNodeError err
+                         , CmdM     env err m
+                         , HasNodeStory env err m
+                         , HasTreeError err
+                         )
+                      => User
+                      -> UserCorpusId
+                      -> Maybe FlowSocialListWith
+                      -> GroupParams
+                      -> (NgramsType, MapListSize, MaxListSize)
+                      -> m (Map NgramsType [NgramsElement])
+buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize, MaxListSize maxListSize) = do
+  allTerms  :: HashMap NgramsTerm (Set NodeId) <- getContextsByNgramsUser uCid nt
 
   -- PrivateFirst for first developments since Public NodeMode is not implemented yet
   socialLists :: FlowCont NgramsTerm FlowListScores
-    <- flowSocialList MySelfFirst user nt ( FlowCont HashMap.empty
+    <- flowSocialList mfslw user nt ( FlowCont HashMap.empty
                                                       $ HashMap.fromList
                                                       $ List.zip (HashMap.keys allTerms)
                                                                  (List.cycle [mempty])
-                                           )
+                                    )
   let
     groupedWithList = toGroupedTree {- groupParams -} socialLists allTerms
 
@@ -116,11 +119,12 @@ buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
     listSize = mapListSize - (List.length mapTerms)
     (mapTerms', candiTerms) = both HashMap.fromList
                             $ List.splitAt listSize
+                            $ List.take maxListSize
                             $ List.sortOn (Down . viewScore . snd)
                             $ HashMap.toList tailTerms'
 
 
-  pure $ Map.fromList [( nt, (toNgramsElement stopTerms)
+  pure $ Map.fromList [( nt, List.take maxListSize $ (toNgramsElement stopTerms)
                           <> (toNgramsElement mapTerms )
                           <> (toNgramsElement $ setListType (Just MapTerm      ) mapTerms' )
                           <> (toNgramsElement $ setListType (Just CandidateTerm) candiTerms)
@@ -146,29 +150,30 @@ buildNgramsTermsList :: ( HasNodeError err
                         , HasNodeStory env err m
                         , HasTreeError err
                         )
-                        => User
-                        -> UserCorpusId
-                        -> MasterCorpusId
-                        -> GroupParams
-                        -> (NgramsType, MapListSize)
-                        -> m (Map NgramsType [NgramsElement])
-buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
+                     => User
+                     -> UserCorpusId
+                     -> MasterCorpusId
+                     -> Maybe FlowSocialListWith
+                     -> GroupParams
+                     -> (NgramsType, MapListSize)
+                     -> m (Map NgramsType [NgramsElement])
+buildNgramsTermsList user uCid mCid mfslw groupParams (nt, _mapListSize)= do
 
 -- Filter 0 With Double
 -- Computing global speGen score
-  printDebug "[buldNgramsTermsList: Sample List] / start" nt
+  printDebug "[buildNgramsTermsList: Sample List] / start" nt
   allTerms :: HashMap NgramsTerm Double <- getTficf_withSample uCid mCid nt
-  printDebug "[buldNgramsTermsList: Sample List / end]" nt
+  printDebug "[buildNgramsTermsList: Sample List / end]" (nt, HashMap.size allTerms)
 
-  printDebug "[buldNgramsTermsList: Flow Social List / start]" nt
+  printDebug "[buildNgramsTermsList: Flow Social List / start]" nt
   -- PrivateFirst for first developments since Public NodeMode is not implemented yet
   socialLists :: FlowCont NgramsTerm FlowListScores
-    <- flowSocialList MySelfFirst user nt ( FlowCont HashMap.empty
+    <- flowSocialList mfslw user nt ( FlowCont HashMap.empty
                                                       $ HashMap.fromList
                                                       $ List.zip (HashMap.keys   allTerms)
                                                                  (List.cycle     [mempty])
-                                           )
-  printDebug "[buldNgramsTermsList: Flow Social List / end]" nt
+                                    )
+  printDebug "[buildNgramsTermsList: Flow Social List / end]" nt
 
   let ngramsKeys = HashMap.keysSet allTerms
 
@@ -209,18 +214,21 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
   userListId    <- defaultList uCid
   masterListId  <- defaultList mCid
 
-  mapTextDocIds <- getNodesByNgramsOnlyUser uCid
+  mapTextDocIds <- getContextsByNgramsOnlyUser uCid
                                             [userListId, masterListId]
                                             nt
                                             selectedTerms
 
+
+  -- printDebug "mapTextDocIds" mapTextDocIds
+
   let
     groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set NodeId))
     groupedTreeScores_SetNodeId = HashMap.filter (\g -> Set.size (view gts'_score g) > 1) -- removing hapax
                                 $ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
 
 
-  printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
+  --printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
 
   -- Coocurrences computation
   --, t1 >= t2 -- permute byAxis diag  -- since matrix symmetric
@@ -264,7 +272,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
   let
     -- use % of list if to big, or Int if to small
     mapSize = 1000 :: Double
-    canSize = mapSize * 5 :: Double
+    canSize = mapSize * 2 :: Double
  
     inclSize = 0.4  :: Double
     exclSize = 1 - inclSize
@@ -312,7 +320,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
           <>-} groupedMultTail
 
     -- Quick FIX
-    candNgramsElement = List.take 5000
+    candNgramsElement = List.take 1000
                       $ toNgramsElement cands <> toNgramsElement cands'
 
     result = Map.unionsWith (<>)