[FEAT] SocialList preparing merge Scores and Grouped (WIP)

src/Gargantext/Core/Text/Group.hs

@@ -23,6 +23,7 @@ import Gargantext.Core.Text (size)
 import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 -- import Gargantext.Core.Text.List.Learn (Model(..))
+import Gargantext.Core.Text.List.Social.Group (FlowListScores)
 import Gargantext.Core.Text.Terms.Mono.Stem (stem)
 import Gargantext.Prelude
 import qualified Data.Set  as Set
@@ -86,33 +87,53 @@ toGroupedText :: Ord b
               -> (a    -> Set NodeId)
               -> [(Text,a)]
               -> Map Stem (GroupedText b)
-toGroupedText fun_stem fun_score fun_texts fun_nodeIds from = groupStems' $ map group from
-  where
-    group (t,d) = let t' = fun_stem t
-                   in (t', GroupedText
-                              Nothing
-                              t
-                              (fun_score d)
-                              (fun_texts d)
-                              (size t)
-                              t'
-                              (fun_nodeIds d)
-                       )
-
-groupStems' :: Ord a => [(Stem, GroupedText a)] -> Map Stem (GroupedText a)
-groupStems' = Map.fromListWith grouping
-  where
-    grouping (GroupedText lt1 label1 score1 group1 s1 stem1 nodes1)
-             (GroupedText lt2 label2 score2 group2 s2 stem2 nodes2)
-             | score1 >= score2 = GroupedText lt label1 score1 (Set.insert label2 gr) s1 stem1 nodes
-             | otherwise        = GroupedText lt label2 score2 (Set.insert label1 gr) s2 stem2 nodes
-        where
-          lt = lt1 <> lt2
-          gr    = Set.union group1 group2
-          nodes = Set.union nodes1 nodes2
+toGroupedText fun_stem fun_score fun_texts fun_nodeIds from =
+  Map.fromListWith grouping $ map group from
+    where
+      group (t,d) = let t' = fun_stem t
+                     in (t', GroupedText
+                                Nothing
+                                t
+                                (fun_score   d)
+                                (fun_texts   d)
+                                (size        t)
+                                t'
+                                (fun_nodeIds d)
+                         )
+
+grouping :: Ord a
+         => GroupedText a
+         -> GroupedText a
+         -> GroupedText a
+grouping (GroupedText lt1 label1 score1 group1 s1 stem1 nodes1)
+         (GroupedText lt2 label2 score2 group2 s2 stem2 nodes2)
+         | score1 >= score2 = GroupedText lt label1 score1 (Set.insert label2 gr) s1 stem1 nodes
+         | otherwise        = GroupedText lt label2 score2 (Set.insert label1 gr) s2 stem2 nodes
+    where
+      lt = lt1 <> lt2
+      gr    = Set.union group1 group2
+      nodes = Set.union nodes1 nodes2
+
+------------------------------------------------------------------------
+
+toGroupedText_FlowListScores :: Ord a
+                             => Map Text (Set NodeId)
+                             -> Map Text FlowListScores
+                             -> Map Text (GroupedText a)
+toGroupedText_FlowListScores = undefined
+
+
+
+toGroupedText_FlowListScores' :: Ord a
+                             => Map Text (Set NodeId)
+                             -> Map Text FlowListScores
+                             -> ( [(Text, Set NodeId)]
+                                ,  Map Text (GroupedText a)
+                                )
+toGroupedText_FlowListScores' = undefined
+
 
 ------------------------------------------------------------------------
-type Group = Lang -> Int -> Int -> Text -> Text
 type Stem  = Text
 type Label = Text
 data GroupedText score =

src/Gargantext/Core/Text/List.hs

@@ -19,6 +19,7 @@ import Control.Lens ((^.), set)
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Ord (Down(..))
 import Data.Map (Map)
+import Data.Set (Set)
 import Data.Text (Text)
 import qualified Data.Char as Char
 import qualified Data.List as List
@@ -30,10 +31,12 @@ import qualified Data.Text as Text
 import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
 import Gargantext.API.Ngrams.Types (RepoCmdM)
 import Gargantext.Core.Text.List.Social (flowSocialList, flowSocialList', FlowSocialListPriority(..), invertForw)
+import Gargantext.Core.Text.List.Social.Group (FlowListScores)
 import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
 import Gargantext.Core.Text.Group
 import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
 import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, groupNodesByNgramsWith, getNodesByNgramsOnlyUser)
 import Gargantext.Database.Action.Metrics.TFICF (getTficf)
 import Gargantext.Database.Prelude (CmdM)
@@ -79,7 +82,17 @@ buildNgramsOthersList ::( HasNodeError err
                         -> (NgramsType, MapListSize)
                         -> m (Map NgramsType [NgramsElement])
 buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
-  ngs  <- groupNodesByNgramsWith groupIt <$> getNodesByNgramsUser uCid nt
+  ngs'  :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt
+
+  socialLists' :: Map Text FlowListScores 
+    <- flowSocialList' MySelfFirst user nt (Set.fromList $ Map.keys ngs')
+    -- PrivateFirst for first developments since Public NodeMode is not implemented yet
+
+  -- 8< 8< 8< 8< 8< 8< 8<
+  let 
+    ngs  :: Map Text (Set Text, Set NodeId) = groupNodesByNgramsWith groupIt ngs'
+  socialLists  <- flowSocialList user nt (Set.fromList $ Map.keys ngs)
+  -- >8 >8 >8 >8 >8 >8 >8
 
   let
     grouped = toGroupedText groupIt (Set.size . snd) fst snd
@@ -87,9 +100,6 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
             $ Map.mapWithKey (\k (a,b) -> (Set.delete k a, b))
             $ ngs
 
-  socialLists <- flowSocialList user nt (Set.fromList $ Map.keys ngs)
-  -- PrivateFirst for first development since Public is not implemented yet
-  socialLists' <- flowSocialList' PrivateFirst user nt (Set.fromList $ Map.keys ngs)
 
   let
     groupedWithList        = map (addListType (invertForw socialLists)) grouped
@@ -125,7 +135,7 @@ buildNgramsTermsList :: ( HasNodeError err
 buildNgramsTermsList user uCid mCid groupParams = do
 
 -- Computing global speGen score
-  allTerms <- Map.toList <$> getTficf uCid mCid NgramsTerms
+  allTerms :: [(Text, Double)] <- Map.toList <$> getTficf uCid mCid NgramsTerms
 
   -- printDebug "head candidates" (List.take 10 $ allTerms)
   -- printDebug "tail candidates" (List.take 10 $ List.reverse $ allTerms)

src/Gargantext/Core/Text/List/Social.hs

@@ -68,26 +68,25 @@ flowSocialList user nt ngrams' = do
 -- | FlowSocialListPriority
 -- Sociological assumption: either private or others (public) first
 -- This parameter depends on the user choice
-data FlowSocialListPriority = PrivateFirst | OthersFirst
+data FlowSocialListPriority = MySelfFirst | OthersFirst
 
 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
-flowSocialListPriority PrivateFirst = [Private, Shared{-, Public -}]
-flowSocialListPriority OthersFirst  = reverse $ flowSocialListPriority PrivateFirst
+flowSocialListPriority MySelfFirst = [Private, Shared{-, Public -}]
+flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
 
 ------------------------------------------------------------------------
 flowSocialList' :: ( RepoCmdM env err m
-                  , CmdM     env err m
-                  , HasNodeError err
-                  , HasTreeError err
-                  )
-                  => FlowSocialListPriority 
+                   , CmdM     env err m
+                   , HasNodeError err
+                   , HasTreeError err
+                   )
+                  => FlowSocialListPriority
                   -> User -> NgramsType -> Set Text
                   -> m (Map Text FlowListScores)
 flowSocialList' flowPriority user nt ngrams' =
   parentUnionsExcl <$> mapM (flowSocialListByMode' user nt ngrams')
                             (flowSocialListPriority flowPriority)
 
-
 ------------------------------------------------------------------------
 flowSocialListByMode :: ( RepoCmdM env err m
                        , CmdM     env err m