[CLEAN] removing previous code (WIP)

src/Gargantext/Core/Text/List.hs

@@ -17,7 +17,7 @@ module Gargantext.Core.Text.List
 
 import Control.Lens hiding (both) -- ((^.), view, over, set, (_1), (_2))
 import Data.Map (Map)
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Monoid (mempty)
 import Data.Ord (Down(..))
 import Data.Set (Set)
@@ -31,7 +31,7 @@ import Gargantext.Core.Text.List.Group.Prelude
 import Gargantext.Core.Text.List.Group.WithStem
 import Gargantext.Core.Text.List.Social
 import Gargantext.Core.Text.List.Social.Prelude
-import Gargantext.Core.Text.Metrics (scored', Scored(..), scored_speExc, scored_genInc, normalizeGlobal, normalizeLocal)
+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)
@@ -50,6 +50,16 @@ import qualified Data.Set  as Set
 import qualified Data.Text as Text
 
 
+{-
+-- TODO maybe useful for later
+isStopTerm :: StopSize -> Text -> Bool
+isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
+  where
+    isStopChar c = not (c `elem` ("- /()%" :: [Char]) || Char.isAlpha c)
+-}
+
+
+
 -- | TODO improve grouping functions of Authors, Sources, Institutes..
 buildNgramsLists :: ( RepoCmdM env err m
                     , CmdM     env err m
@@ -94,20 +104,9 @@ buildNgramsOthersList user uCid groupParams (nt, MapListSize mapListSize) = do
                                                       $ List.zip (Map.keys allTerms) 
                                                                  (List.cycle [mempty])
                                            )
-{-
-  printDebug "flowSocialList'"
-               $ Map.filter (not . ((==) Map.empty) . (view fls_parents))
-               $ view flc_scores socialLists'
--}
-
   let
     groupedWithList = toGroupedTree groupParams socialLists' allTerms
 
-{-
-  printDebug "groupedWithList"
-              $ view flc_cont groupedWithList
--}
-
   let
     (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) $ view flc_scores groupedWithList
     (mapTerms, tailTerms') = Map.partition ((== Just MapTerm)  . viewListType) tailTerms
@@ -149,36 +148,15 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
                                                       $ List.zip (Map.keys allTerms) 
                                                                  (List.cycle [mempty])
                                            )
-{-
-  printDebug "flowSocialList'"
-               $ Map.filter (not . ((==) Map.empty) . (view fls_parents))
-               $ view flc_scores socialLists'
-
--}
   let groupedWithList = toGroupedTree groupParams socialLists' allTerms
-
-{-
--- TODO remove
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
-  -- First remove stops terms
-  socialLists <- flowSocialList user nt (Set.fromList $ map fst $ Map.toList allTerms)
-
-  -- Grouping the ngrams and keeping the maximum score for label
-  let grouped = groupedTextWithStem ( GroupedTextParams (groupWith groupParams) identity (const Set.empty) (const Set.empty) {-(size . _gt_label)-} ) allTerms
-
-      groupedWithList = map (addListType (invertForw socialLists)) grouped
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
--}
-
       (stopTerms, candidateTerms) = Map.partition ((== Just StopTerm) . viewListType)
                                   $ view flc_scores groupedWithList
-      -- (groupedMono, groupedMult)  = Map.partition (\t -> t ^. gt_size < 2) candidateTerms
       (groupedMono, groupedMult)  = Map.partitionWithKey (\t _v -> size t < 2) candidateTerms
 
-  -- printDebug "\n * stopTerms * \n" stopTerms
   -- splitting monterms and multiterms to take proportional candidates
   let
-    listSizeGlobal = 2000 :: Double -- use % of list if to big, or Int if too small
+    -- use % of list if to big, or Int if too small
+    listSizeGlobal = 2000 :: Double
     monoSize = 0.4  :: Double
     multSize = 1 - monoSize
 
@@ -190,24 +168,9 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
     (groupedMonoHead, groupedMonoTail) = splitAt monoSize groupedMono
     (groupedMultHead, groupedMultTail) = splitAt multSize groupedMult
 
-  -- printDebug "groupedMonoHead" (List.length groupedMonoHead)
-  -- printDebug "groupedMonoTail" (List.length groupedMonoHead)
-  -- printDebug "groupedMultHead" (List.length groupedMultHead)
-  -- printDebug "groupedMultTail" (List.length groupedMultTail)
-
-{-
-  let
-    -- Get Local Scores now for selected grouped ngrams
-    -- TODO HasTerms 
-    selectedTerms = Set.toList $ List.foldl'
-                      (\set' (GroupedText _ l' _ g _ _ _ ) -> Set.union set'
-                                                            $ Set.insert l' g
-                      )
-                      Set.empty  
-                      (groupedMonoHead <> groupedMultHead)
--}
     selectedTerms = Set.toList $ hasTerms (groupedMonoHead <> groupedMultHead)
-  -- TO remove (and remove HasNodeError instance)
+ 
+ -- TO remove (and remove HasNodeError instance)
   userListId    <- defaultList uCid
   masterListId  <- defaultList mCid
 
@@ -216,30 +179,11 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
                                             nt
                                             selectedTerms
 
-  -- TODO
-  let
-    groupedTreeScores_SetNodeId = setScoresWith mapTextDocIds (groupedMonoHead <> groupedMultHead)
-
-{-
--- TODO remove
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
   let
-    mapGroups   = Map.fromList
-                $ map (\g -> (g ^. gt_stem, g))
-                $ groupedMonoHead <> groupedMultHead
-
-    -- grouping with Set NodeId
-    contextsAdded = foldl' (\mapGroups' k ->
-                                    let k' = groupWith groupParams k in
-                                        case Map.lookup k' mapGroups'  of
-                                          Nothing -> mapGroups'
-                                          Just g  -> case Map.lookup k mapTextDocIds of
-                                            Nothing -> mapGroups'
-                                            Just ns -> Map.insert k' (over gt_nodes (Set.union ns) g) mapGroups'
-                           )
-                  mapGroups
-                  $ Map.keys mapTextDocIds
--}
+    groupedTreeScores_SetNodeId :: Map Text (GroupedTreeScores (Set NodeId))
+    groupedTreeScores_SetNodeId = undefined
+    -- setScoresWith (\_ _ -> mempty) (groupedMonoHead <> groupedMultHead)
+    -- groupedTreeScores_SetNodeId = setScoresWith ((fromMaybe mempty) . ((flip Map.lookup) mapTextDocIds)) (groupedMonoHead <> groupedMultHead)
 
   -- | Coocurrences computation
   --, t1 >= t2 -- permute byAxis diag  -- since matrix symmetric
@@ -255,43 +199,24 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
   let
     -- computing scores
     mapScores f = Map.fromList
-                $ map (\s@(Scored t g s') -> (t, f s))
+                $ map (\g -> (view scored_terms g, f g))
                 $ normalizeGlobal
                 $ map normalizeLocal
                 $ scored' mapCooc
 
   let
-    -- groupedTreeScores_SpeGen :: GroupedTreeScores (Scored Double)
-    groupedTreeScores_SpeGen = setScoresWith (mapScores identity) (groupedMonoHead <> groupedMultHead)
-
-{-
--- TODO remove
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
-    groupsWithScores = catMaybes
-                     $ map (\(stem, g)
-                             -> case Map.lookup stem mapScores' of
-                                 Nothing -> Nothing
-                                 Just s'  -> set gts'_score s' g
-                            ) $ Map.toList $ view flc_scores contextsAdded
-      where
-        mapScores' = mapScores identity
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
--- TODO remove
--}
-        -- adapt2 TOCHECK with DC
-  -- printDebug "groupsWithScores" groupsWithScores
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
--- TODO remove
---}
+    groupedTreeScores_SpeGen :: Map Text (GroupedTreeScores (Scored Double))
+    groupedTreeScores_SpeGen = undefined
+    -- setScoresWith (\k v -> set gts'_score (Scored "" 0 0) v) (groupedMonoHead <> groupedMultHead)
+    -- groupedTreeScores_SpeGen = setScoresWith (\k v -> set gts'_score (fromMaybe (Scored "" 0 0) $ Map.lookup k (mapScores identity)) v) (groupedMonoHead <> groupedMultHead)
 
   let
     -- sort / partition / split
-      -- filter mono/multi again
+    -- filter mono/multi again
     (monoScored, multScored) = Map.partitionWithKey (\t _v -> size t < 2) groupedTreeScores_SpeGen
     -- (monoScored, multScored) = List.partition (\g -> _gt_size g < 2) groupsWithScores
 
       -- filter with max score
-    -- partitionWithMaxScore = List.partition (\g -> let (s1,s2) = viewScore g in s1 > s2 )
     partitionWithMaxScore = Map.partition (\g -> (view scored_genInc $ view gts'_score g) 
                                                > (view scored_speExc $ view gts'_score g)
                                           )
@@ -299,25 +224,23 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
     (monoScoredIncl, monoScoredExcl) = partitionWithMaxScore monoScored
     (multScoredIncl, multScoredExcl) = partitionWithMaxScore multScored
 
-      -- splitAt
+  -- splitAt
   let
-    listSizeLocal = 1000 :: Double -- use % of list if to big, or Int if to small
+    -- use % of list if to big, or Int if to small
+    listSizeLocal = 1000 :: Double
     inclSize = 0.4  :: Double
     exclSize = 1 - inclSize
 
-    --splitAt' n' = (both (Map.fromListWith (<>))) . (List.splitAt (round $ n' * listSizeLocal)) 
     splitAt' n' = (both (Map.fromList)) . (List.splitAt (round $ n' * listSizeLocal)) 
-    
-    sortOn f = (List.sortOn (Down . f . _gts'_score . snd)) . Map.toList 
-    --sortOn f = (List.sortOn (Down . (gts'_score))) . Map.toList 
-    -- sort = (List.sortOn (Down . viewScore))
+    sortOn   f  = (List.sortOn (Down . f . _gts'_score . snd)) . Map.toList 
 
-    (monoScoredInclHead, monoScoredInclTail) = splitAt' (monoSize * inclSize / 2) $ (sortOn _scored_genInc) monoScoredIncl
-    (monoScoredExclHead, monoScoredExclTail) = splitAt' (monoSize * inclSize / 2) $ (sortOn _scored_speExc) monoScoredExcl
-
-    (multScoredInclHead, multScoredInclTail) = splitAt' (multSize * exclSize / 2) $ (sortOn _scored_genInc) multScoredIncl
-    (multScoredExclHead, multScoredExclTail) = splitAt' (multSize * exclSize / 2) $ (sortOn _scored_speExc) multScoredExcl
+    monoInc_size = monoSize * inclSize / 2
+    (monoScoredInclHead, monoScoredInclTail) = splitAt' monoInc_size $ (sortOn _scored_genInc) monoScoredIncl
+    (monoScoredExclHead, monoScoredExclTail) = splitAt' monoInc_size $ (sortOn _scored_speExc) monoScoredExcl
 
+    multExc_size = multSize * exclSize / 2
+    (multScoredInclHead, multScoredInclTail) = splitAt' multExc_size $ (sortOn _scored_genInc) multScoredIncl
+    (multScoredExclHead, multScoredExclTail) = splitAt' multExc_size $ (sortOn _scored_speExc) multScoredExcl
 
     -- Final Step building the Typed list
     termListHead = maps <> cands
@@ -336,30 +259,13 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
 
     termListTail = (setListType (Just CandidateTerm)) (groupedMonoTail <> groupedMultTail)
 
---  printDebug "monoScoredInclHead" monoScoredInclHead
---  printDebug "monoScoredExclHead" monoScoredExclTail
---  printDebug "multScoredInclHead" multScoredInclHead
---  printDebug "multScoredExclTail" multScoredExclTail
-
   let result = Map.unionsWith (<>)
        [ Map.fromList [( nt, toNgramsElement termListHead
                           <> toNgramsElement termListTail
                           <> toNgramsElement stopTerms
                       )]
        ]
-  -- printDebug "\n result \n" r
 
   pure result
 
-
-
-toGargList :: Maybe ListType -> b -> (Maybe ListType, b)
-toGargList l n = (l,n)
-
-
-isStopTerm :: StopSize -> Text -> Bool
-isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
-  where
-    isStopChar c = not (c `elem` ("- /()%" :: [Char]) || Char.isAlpha c)
-
 ------------------------------------------------------------------------------

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

@@ -18,7 +18,7 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Group
   where
 
-import Control.Lens (set, view)
+import Control.Lens (set, view, over)
 import Data.Set (Set)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
@@ -52,30 +52,24 @@ toGroupedTree groupParams flc scores = {-view flc_scores-} flow2
         True  -> flow1
         False -> groupWithStem' groupParams flow1
 
-setScoresWith :: Map Text a
-              -> Map Text (GroupedTreeScores b)
+{-
+DM.foldlWithKey :: (a -> k -> b -> a) -> a -> Map k b -> a
+-}
+
+setScoresWith :: (Ord a, Ord b)
+              =>  (Text -> (GroupedTreeScores a) -> (GroupedTreeScores b))
               -> Map Text (GroupedTreeScores a)
-setScoresWith = undefined
+              -> Map Text (GroupedTreeScores b)
+setScoresWith = Map.mapWithKey
 
+{-
+Map.foldlWithKey (\k v -> 
+                                   {- over gts'_children (setScoresWith fun)
+                                          $ over gts'_score    (fun k)
+                                          -} 
+                                          set gts'_score Set.empty -- (fun k)
+                                          v
+                                   ) mempty m
+-}
 
 ------------------------------------------------------------------------
-------------------------------------------------------------------------
--- 8<-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
--- | TODO To be removed
-toGroupedText :: GroupedTextParams a b
-              -> Map Text FlowListScores
-              -> Map Text (Set NodeId)
-              -> Map Stem (GroupedText Int)
-toGroupedText groupParams scores =
-  (groupWithStem groupParams) . (groupWithScores scores)
-
-
-addListType :: Map Text ListType -> GroupedText a -> GroupedText a
-addListType m g = set gt_listType (hasListType m g) g
-  where
-    hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
-    hasListType m' (GroupedText _ label _ g' _ _ _) =
-        List.foldl' (<>) Nothing
-      $ map (\t -> Map.lookup t m')
-      $ Set.toList
-      $ Set.insert label g'

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

@@ -32,6 +32,7 @@ import qualified Data.Set  as Set
 import qualified Data.Map  as Map
 import qualified Data.List as List
 
+type Stem = Text
 ------------------------------------------------------------------------
 -- | Main Types to group With Scores but preserving Tree dependencies
 -- Therefore there is a need of Tree of GroupedTextScores
@@ -162,108 +163,3 @@ instance ToNgramsElement (Text, GroupedTreeScores a) where
                     $ view gts'_children gts'
 
 
-
-
-
-
-
-
--- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
--- TODO to remove below
-data GroupedWithListScores =
-  GroupedWithListScores { _gwls_listType :: !(Maybe ListType)
-                        , _gwls_children :: !(Set Text)
-                        } deriving (Show)
-
-instance Semigroup GroupedWithListScores where
-  (<>) (GroupedWithListScores c1 l1)
-       (GroupedWithListScores c2 l2) =
-        GroupedWithListScores (c1 <> c2)
-                              (l1 <> l2)
-
-instance Monoid GroupedWithListScores where
-  mempty = GroupedWithListScores Nothing Set.empty
-
-makeLenses ''GroupedWithListScores
-
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
--- | Group With Stem Main Types
-type Stem  = Text
-data GroupedText score =
-  GroupedText { _gt_listType :: !(Maybe ListType)
-              , _gt_label    :: !Text
-              , _gt_score    :: !score
-              , _gt_children :: !(Set Text)
-              , _gt_size     :: !Int
-              , _gt_stem     :: !Stem -- needed ?
-              , _gt_nodes    :: !(Set NodeId)
-              }  deriving (Show, Eq) --}
-
--- | Lenses Instances
-makeLenses 'GroupedText
-
-instance ViewListType (GroupedText a) where
-  viewListType = view gt_listType
-
-instance SetListType (GroupedText a) where
-  setListType = set gt_listType
-
-instance Ord a => ViewScore (GroupedText a) a where
-  viewScore = (view gt_score)
-
-{-
-instance Show score => Show (GroupedText score) where
-  show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
---}
-
-{-
-instance (Eq a) => Eq (GroupedText a) where
-  (==) (GroupedText _ _ score1 _ _ _ _)
-       (GroupedText _ _ score2 _ _ _ _) = (==) score1 score2
--}
-
-instance (Eq a, Ord a) => Ord (GroupedText a) where
-  compare (GroupedText _ _ score1 _ _ _ _)
-          (GroupedText _ _ score2 _ _ _ _) = compare score1 score2
-
-instance Ord a => Semigroup (GroupedText a) where
-  (<>) (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
-
-instance SetListType [GroupedText Int] where
-  setListType lt = map (setListType lt)
-
-
-instance ToNgramsElement (Map Stem (GroupedText Int)) where
-  toNgramsElement = List.concat . (map toNgramsElement) . Map.elems
-
-
-instance ToNgramsElement [GroupedText a] where
-  toNgramsElement = List.concat . (map toNgramsElement)
-
-instance ToNgramsElement (GroupedText a) where
-  toNgramsElement :: GroupedText a -> [NgramsElement]
-  toNgramsElement (GroupedText listType label _ setNgrams _ _ _) =
-    [parentElem] <> childrenElems
-      where
-        parent = label
-        children = Set.toList setNgrams
-        parentElem    = mkNgramsElement (NgramsTerm parent)
-                                        (fromMaybe CandidateTerm listType)
-                                        Nothing
-                                        (mSetFromList (NgramsTerm <$> children))
-        childrenElems = map (\t -> mkNgramsElement t (fromMaybe CandidateTerm $ listType)
-                                                   (Just $ RootParent (NgramsTerm parent) (NgramsTerm parent))
-                                                   (mSetFromList [])
-                            ) (NgramsTerm <$> children)
-
-
--- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--

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

@@ -98,78 +98,4 @@ toGroupedTree' m notEmpty
 
 
 
---8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<--
--- TODO TO BE REMOVED
-data GroupedTextScores score =
-  GroupedTextScores { _gts_listType :: !(Maybe ListType)
-                    , _gts_score    :: score
-                    , _gts_children :: !(Set Text)
-                    } deriving (Show)
-makeLenses 'GroupedTextScores
-instance Semigroup a => Semigroup (GroupedTextScores a) where
-  (<>) (GroupedTextScores  l1 s1 c1)
-       (GroupedTextScores  l2 s2 c2)
-      = GroupedTextScores (l1 <> l2)
-                          (s1 <> s2)
-                          (c1 <> c2)
-
--- | Main function
-groupWithScores :: Map Text FlowListScores
-                -> Map Text (Set NodeId)
-                -> Map Text (GroupedTextScores (Set NodeId))
-groupWithScores scores ms = orphans <> groups
-  where
-    groups = addScore ms
-           $ fromGroupedScores
-           $ fromListScores scores
-    orphans = addIfNotExist scores ms
-
-------------------------------------------------------------------------
-addScore :: Map Text (Set NodeId)
-         -> Map Text (GroupedTextScores (Set NodeId))
-         -> Map Text (GroupedTextScores (Set NodeId))
-addScore mapNs = Map.mapWithKey scoring
-  where
-
-    scoring k g = set gts_score ( Set.unions
-                                $ catMaybes
-                                $ map (\n -> Map.lookup n mapNs)
-                                $ [k] <> (Set.toList $ view gts_children g)
-                                ) g
-
-addIfNotExist :: Map Text FlowListScores
-              -> Map Text (Set NodeId)
-              -> Map Text (GroupedTextScores (Set NodeId))
-addIfNotExist mapSocialScores mapScores =
-  foldl' (addIfNotExist' mapSocialScores) mempty $ Map.toList mapScores
-    where
-      addIfNotExist' mss m (t,ns) =
-        case Map.lookup t mss of
-          Nothing -> Map.alter (add ns) t m
-          _       -> m
-
-      add ns' Nothing = Just $ GroupedTextScores Nothing ns' mempty
-      add _ _         = Nothing -- should not be present
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-fromGroupedScores :: Map Parent GroupedWithListScores
-                  -> Map Parent (GroupedTextScores (Set NodeId))
-fromGroupedScores = Map.map (\(GroupedWithListScores l c) -> GroupedTextScores l mempty c)
-
-------------------------------------------------------------------------
-fromListScores :: Map Text FlowListScores -> Map Parent GroupedWithListScores
-fromListScores = Map.fromListWith (<>) . (map fromScores') . Map.toList
-  where
-    fromScores' :: (Text, FlowListScores) -> (Text, GroupedWithListScores)
-    fromScores' (t, fs) = case (keyWithMaxValue $ view fls_parents fs) of
-      Nothing     -> (t, set gwls_listType (keyWithMaxValue $ view fls_listType fs) mempty)
-          -- Parent case: taking its listType, for now children Set is empty
- 
-      Just parent -> (parent, set gwls_children (Set.singleton t) mempty)
-          -- We ignore the ListType of children for the parents' one
-          -- added after and winner of semigroup actions
-
---8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<--
-
 

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

@@ -185,65 +185,3 @@ mergeWith_Double fun flc = FlowCont scores mempty
 
 
 
-
-
-
-
-
-
-
-
-
-
--- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
--------------------------------------------------------------------
--- TODO to remove
-data GroupedTextParams a b =
-  GroupedTextParams { _gt_fun_stem    :: Text -> Text
-                    , _gt_fun_score   :: a -> b
-                    , _gt_fun_texts   :: a -> Set Text
-                    , _gt_fun_nodeIds :: a -> Set NodeId
-                    -- , _gt_fun_size    :: a -> Int
-                    }
-makeLenses 'GroupedTextParams
-
-
-groupWithStem :: {- ( HasNgrams a
-                 , HasGroupWithScores a b
-                 , Semigroup a
-                 ,  Ord b
-                 ) 
-              => -} GroupedTextParams a b
-              -> Map Text (GroupedTextScores (Set NodeId))
-              -> Map Stem (GroupedText Int)
-groupWithStem _ = Map.mapWithKey scores2groupedText
-
-scores2groupedText :: Text -> GroupedTextScores (Set NodeId) -> GroupedText Int
-scores2groupedText t g = GroupedText (view gts_listType g)
-                                     t
-                                     (Set.size $ view gts_score g)
-                                     (Set.delete t $ view gts_children g)
-                                     (size t)
-                                     t
-                                     (view gts_score g)
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-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)
-                         )
-------------------------------------------------------------------------

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

@@ -98,84 +98,3 @@ flowSocialList' flowPriority user nt flc =
           . toFlowListScores (keepAllParents nt'') flc''
 
 
-
----8<-TODO-REMOVE ALL BELOW--8<--8<-- 8<-- 8<--8<--8<--
-
--- | Choice depends on Ord instance of ListType
--- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm
--- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
--- (we minimize errors on MapTerms if doubt)
---  * TODO what if equality ?
---  * TODO maybe use social groups too
-toSocialList :: Map Text (Map ListType Int)
-             -> Set Text
-             -> Map (Maybe ListType) (Set Text)
-toSocialList m = Map.fromListWith (<>)
-               . Set.toList
-               . Set.map (toSocialList1 m)
-
-toSocialList1 :: Map Text (Map ListType Int)
-             -> Text
-             -> (Maybe ListType, Set Text)
-toSocialList1 m t = case Map.lookup t m of
-  Nothing -> (Nothing, Set.singleton t)
-  Just  m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
-              , Set.singleton t
-              )
-
-toSocialList1_testIsTrue :: Bool
-toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
-  where
-    result = toSocialList1 (Map.fromList [(token, m)]) token
-    token  = "token"
-    m = Map.fromList [ (CandidateTerm, 1)
-                     , (MapTerm      , 2)
-                     , (StopTerm     , 3)
-                     ]
-
-
-
-flowSocialList :: ( RepoCmdM env err m
-                  , CmdM     env err m
-                  , HasNodeError err
-                  , HasTreeError err
-                  )
-                  => User -> NgramsType -> Set Text
-                  -> m (Map ListType (Set Text))
-flowSocialList user nt ngrams' = do
-  -- Here preference to privateLists (discutable: let user choice)
-  privateListIds <- findListsId user Private
-  privateLists <- flowSocialListByMode privateListIds nt ngrams'
-  -- printDebug "* privateLists *: \n" privateLists
-
-  sharedListIds <- findListsId user Shared
-  sharedLists  <- flowSocialListByMode sharedListIds nt (termsByList CandidateTerm privateLists)
-  -- printDebug "* sharedLists *: \n" sharedLists
-
-  -- TODO publicMapList:
-  -- Note: if both produce 3 identic repetition => refactor mode
-  -- publicListIds <- findListsId Public user
-  -- publicLists   <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
-
-  let result = parentUnionsExcl
-             [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
-             , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
-             -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
-             ]
-  -- printDebug "* socialLists *: results \n" result
-  pure result
-
-
--- | TODO remove
-flowSocialListByMode :: ( RepoCmdM env err m
-                        , CmdM     env err m
-                        , HasNodeError err
-                        , HasTreeError err
-                        )
-                     => [NodeId]-> NgramsType -> Set Text
-                     -> m (Map (Maybe ListType) (Set Text))
-flowSocialListByMode      [] _nt ngrams' = pure $ Map.fromList [(Nothing, ngrams')]
-flowSocialListByMode listIds  nt ngrams' = do
-    counts  <- countFilterList ngrams' nt listIds Map.empty
-    let r = toSocialList counts ngrams'
-    pure r

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

@@ -110,36 +110,3 @@ hasParent t m = case Map.lookup t m of
 keyWithMaxValue :: Map a b -> Maybe a
 keyWithMaxValue m = (fst . fst) <$> Map.maxViewWithKey m
 
-
-------------------------------------------------------------------------
--- | Tools TODO clean it (some need to be removed)
-------------------------------------------------------------------------
-termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
-termsByList CandidateTerm m = Set.unions
-                          $ map (\lt -> fromMaybe Set.empty $ Map.lookup lt m)
-                          [ Nothing, Just CandidateTerm ]
-termsByList l m =
-  fromMaybe Set.empty $ Map.lookup (Just l) m
-
-------------------------------------------------------------------------
-unions' :: (Ord a, Semigroup a, Semigroup b, Ord b)
-      => [Map a (Set b)] -> Map a (Set b)
-unions' = invertBack . Map.unionsWith (<>) . map invertForw
-
-invertForw :: (Ord b, Semigroup a) => Map a (Set b) -> Map b a
-invertForw = Map.unionsWith (<>)
-           . (map (\(k,st) -> Map.fromSet (\_ -> k) st))
-           . Map.toList
-
-invertBack :: (Ord a, Ord b) => Map b a -> Map a (Set b)
-invertBack = Map.fromListWith (<>)
-           . (map (\(b,a) -> (a, Set.singleton b)))
-           .  Map.toList
-
-unions_test :: Map ListType (Set Text)
-unions_test = unions' [m1, m2]
-  where
-    m1 = Map.fromList [ (StopTerm     , Set.singleton "Candidate")]
-    m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
-                      , (MapTerm      , Set.singleton "Candidate")
-                      ]