[CLEAN] SocialLists

src/Gargantext/Core/Text/List/Group/WithScores.hs

@@ -15,7 +15,7 @@ module Gargantext.Core.Text.List.Group.WithScores
   where
 
 import Data.Maybe (fromMaybe)
-import Control.Lens (makeLenses, set, (^.), (%~))
+import Control.Lens (makeLenses, set, (^.), (%~), over, view)
 import Data.Set (Set)
 import Data.Map (Map)
 import Data.Text (Text)
@@ -35,47 +35,14 @@ import qualified Data.List as List
 import qualified Data.Text as Text
 
 
-
-
+------------------------------------------------------------------------
+-- | Main Types
 data GroupedWithListScores =
   GroupedWithListScores { _gwls_children :: !(Set Text)
                         , _gwls_listType :: !(Maybe ListType)
                         }
 makeLenses ''GroupedWithListScores
 
-toGroupedWithListScores :: Map Text FlowListScores -> Map Text GroupedWithListScores
-toGroupedWithListScores ms = foldl' (toGroup ms) Map.empty (Map.toList ms)
-  where
-    toGroup :: Map Text FlowListScores
-            -> Map Text GroupedWithListScores
-            -> (Text, FlowListScores)
-            -> Map Text GroupedWithListScores
-    toGroup ms' result (t,fs) = case (keyWithMaxValue $ fs ^. flc_parents) of
-      Nothing     -> Map.alter (addGroupedParent (t,fs)) t  result
-      Just parent -> Map.alter (addGroupedChild  (t,fs)) parent result
-
-
-addGroupedParent :: (Text, FlowListScores) -> Maybe GroupedWithListScores -> Maybe GroupedWithListScores
-addGroupedParent (_,fs) Nothing = Just $ GroupedWithListScores Set.empty list
-  where
-    list = keyWithMaxValue $ fs ^. flc_lists
-
-addGroupedParent (t,fs) (Just g) = Just $ set gwls_listType list
-                                        $ (%~) gwls_children (Set.insert t) g
-  where
-    list     = keyWithMaxValue $ fs ^. flc_lists
-
-
-addGroupedChild :: (Text, FlowListScores) -> Maybe GroupedWithListScores -> Maybe GroupedWithListScores
-addGroupedChild (t,fs) Nothing  = Just $ GroupedWithListScores (Set.singleton t) list
-  where
-    list     = keyWithMaxValue $ fs ^. flc_lists
-
-addGroupedChild (t,fs) (Just g) = Just $ (%~) gwls_listType (<> list)
-                                       $ (%~) gwls_children (Set.insert t) g
-  where
-    list     = keyWithMaxValue $ fs ^. flc_lists
-
 
 data GroupedTextScores score =
   GroupedTextScores { _gts_listType :: !(Maybe ListType)
@@ -84,8 +51,8 @@ data GroupedTextScores score =
                     }
 makeLenses 'GroupedTextScores
 
-
-
+------------------------------------------------------------------------
+-- | Main function
 groupWithScores :: Map Text FlowListScores
                 -> Map Text (Set NodeId)
                 -> Map Text (GroupedTextScores (Set NodeId))
@@ -95,10 +62,49 @@ groupWithScores scores =
                          k a
                  )
 
-scoresToGroupedTextScores :: Maybe GroupedWithListScores
+  where
+    scoresToGroupedTextScores :: Maybe GroupedWithListScores
                               -> Text -> Set NodeId
                               -> GroupedTextScores (Set NodeId)
-scoresToGroupedTextScores Nothing t ns  = undefined
-scoresToGroupedTextScores (Just g) t ns = undefined
+    scoresToGroupedTextScores Nothing  t ns = GroupedTextScores Nothing ns Set.empty
+    scoresToGroupedTextScores (Just g) t ns = GroupedTextScores list ns (Set.singleton t)
+      where
+        list = view gwls_listType g
+------------------------------------------------------------------------
+toGroupedWithListScores :: Map Text FlowListScores -> Map Text GroupedWithListScores
+toGroupedWithListScores ms = foldl' (toGroup ms) Map.empty (Map.toList ms)
+  where
+    toGroup :: Map Text FlowListScores
+            -> Map Text GroupedWithListScores
+            -> (Text, FlowListScores)
+            -> Map Text GroupedWithListScores
+    toGroup ms' result (t,fs) = case (keyWithMaxValue $ view flc_parents fs) of
+      Nothing     -> Map.alter (addGroupedParent (t,fs)) t  result
+      Just parent -> Map.alter (addGroupedChild  (t,fs)) parent result
+
 
+    addGroupedParent :: (Text, FlowListScores)
+                     -> Maybe GroupedWithListScores
+                     -> Maybe GroupedWithListScores
+    addGroupedParent (_,fs) Nothing = Just $ GroupedWithListScores Set.empty list
+      where
+        list = keyWithMaxValue $ view flc_lists fs
+
+    addGroupedParent (t,fs) (Just g) = Just $ set  gwls_listType list
+                                            $ over gwls_children (Set.insert t) g
+      where
+        list     = keyWithMaxValue $ view flc_lists fs
+
+
+    addGroupedChild :: (Text, FlowListScores)
+                    -> Maybe GroupedWithListScores
+                    -> Maybe GroupedWithListScores
+    addGroupedChild (t,fs) Nothing  = Just $ GroupedWithListScores (Set.singleton t) list
+      where
+        list     = keyWithMaxValue $ view flc_lists fs
+
+    addGroupedChild (t,fs) (Just g) = Just $ over gwls_listType (<> list)
+                                           $ over gwls_children (Set.insert t) g
+      where
+        list     = keyWithMaxValue $ view flc_lists fs
 

src/Gargantext/Core/Text/List/Group/WithStem.hs

@@ -18,43 +18,24 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Group.WithStem
   where
 
-import Data.Maybe (fromMaybe)
-import Control.Lens (makeLenses, set, (^.))
+import Control.Lens (makeLenses, view)
 import Data.Set (Set)
 import Data.Map (Map)
 import Data.Text (Text)
-import Data.Semigroup (Semigroup, (<>))
+import Data.Semigroup (Semigroup)
 import Gargantext.Core (Lang(..))
 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.Scores (FlowListScores(..), flc_lists, flc_parents, keyWithMaxValue)
 import Gargantext.Core.Text.List.Group.WithScores
 import Gargantext.Core.Text.Terms.Mono.Stem (stem)
-import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
 import qualified Data.Set  as Set
 import qualified Data.Map  as Map
 import qualified Data.List as List
 import qualified Data.Text as Text
 
-{-
-data NgramsListBuilder = BuilderStepO { stemSize :: !Int
-                                      , stemX    :: !Int
-                                      , stopSize :: !StopSize
-                                      }
-                       | BuilderStep1 { withModel :: !Model }
-                       | BuilderStepN { withModel :: !Model }
-                       | Tficf { nlb_lang           :: !Lang
-                               , nlb_group1         :: !Int
-                               , nlb_group2         :: !Int
-                               , nlb_stopSize       :: !StopSize
-                               , nlb_userCorpusId   :: !UserCorpusId
-                               , nlb_masterCorpusId :: !MasterCorpusId
-                               }
--}
-
+-- | Main Types
 data StopSize = StopSize {unStopSize :: !Int}
 
 -- | TODO: group with 2 terms only can be
@@ -68,20 +49,7 @@ data GroupParams = GroupParams { unGroupParams_lang  :: !Lang
                                }
                  | GroupIdentity
 
-ngramsGroup :: GroupParams
-            -> Text
-            -> Text
-ngramsGroup GroupIdentity  = identity
-ngramsGroup (GroupParams l _m _n _) = 
-                    Text.intercalate " "
-                  . map (stem l)
-                  -- . take n
-                  . List.sort
-                  -- . (List.filter (\t -> Text.length t > m))
-                  . Text.splitOn " "
-                  . Text.replace "-" " "
 
-------------------------------------------------------------------------
 data GroupedTextParams a b =
   GroupedTextParams { _gt_fun_stem    :: Text -> Text
                     , _gt_fun_score   :: a -> b
@@ -89,28 +57,8 @@ data GroupedTextParams a b =
                     , _gt_fun_nodeIds :: a -> Set NodeId
                     -- , _gt_fun_size    :: a -> Int
                     }
-
 makeLenses 'GroupedTextParams
 
-groupedTextWithStem :: Ord b
-              => GroupedTextParams a b
-              -> Map Text a
-              -> Map Stem (GroupedText b)
-groupedTextWithStem gparams from =
-  Map.fromListWith (<>) $ map (group gparams) $ Map.toList from
-    where
-      group gparams' (t,d) = let t' = (gparams' ^. gt_fun_stem) t
-                     in (t', GroupedText
-                                Nothing
-                                t
-                                ((gparams' ^. gt_fun_score)   d)
-                                ((gparams' ^. gt_fun_texts)   d)
-                                (size        t)
-                                t'
-                                ((gparams' ^. gt_fun_nodeIds) d)
-                         )
-
-------------------------------------------------------------------------
 type Stem  = Text
 data GroupedText score =
   GroupedText { _gt_listType :: !(Maybe ListType)
@@ -158,4 +106,38 @@ groupWithStem :: {- ( HasNgrams a
               -> Map Stem (GroupedText Int)
 groupWithStem _ = undefined -- TODO (just for tests on Others Ngrams which do not need stem)
 
+
+------------------------------------------------------------------------
+ngramsGroup :: GroupParams
+            -> Text
+            -> Text
+ngramsGroup GroupIdentity  = identity
+ngramsGroup (GroupParams l _m _n _) = 
+                    Text.intercalate " "
+                  . map (stem l)
+                  -- . take n
+                  . List.sort
+                  -- . (List.filter (\t -> Text.length t > m))
+                  . Text.splitOn " "
+                  . Text.replace "-" " "
+
+------------------------------------------------------------------------
+groupedTextWithStem :: Ord b
+              => GroupedTextParams a b
+              -> Map Text a
+              -> Map Stem (GroupedText b)
+groupedTextWithStem gparams from =
+  Map.fromListWith (<>) $ map (group gparams) $ Map.toList from
+    where
+      group gparams' (t,d) = let t' = (view gt_fun_stem gparams') t
+                     in (t', GroupedText
+                                Nothing
+                                t
+                                ((view gt_fun_score gparams')   d)
+                                ((view gt_fun_texts gparams')   d)
+                                (size        t)
+                                t'
+                                ((view gt_fun_nodeIds gparams') d)
+                         )
+
 ------------------------------------------------------------------------