diff --git a/src/Gargantext/Core/Text/List.hs b/src/Gargantext/Core/Text/List.hs index e22dea15c6d4825e6d37fdb8803c6f6765571202..a74fc9c10544852b9ebb6720868bd1bbc7ad4fdf 100644 --- a/src/Gargantext/Core/Text/List.hs +++ b/src/Gargantext/Core/Text/List.hs @@ -15,7 +15,6 @@ Portability : POSIX module Gargantext.Core.Text.List where - import Control.Lens ((^.), view, over) import Data.Map (Map) import Data.Maybe (catMaybes) @@ -94,12 +93,12 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do $ List.zip (Map.keys ngs') (List.cycle [mempty]) ) - {- printDebug "flowSocialList'" $ Map.filter (not . ((==) Map.empty) . (view fls_parents)) $ view flc_scores socialLists' -} + let groupedWithList = toGroupedTreeText groupIt socialLists' ngs' @@ -152,8 +151,8 @@ buildNgramsTermsList user uCid mCid groupParams = do groupedWithList = map (addListType (invertForw socialLists)) grouped (stopTerms, candidateTerms) = Map.partition ((== Just StopTerm) . viewListType) groupedWithList - (groupedMono, groupedMult) = Map.partition (\t -> t ^. gt_size < 2) candidateTerms - -- (groupedMono, groupedMult) = Map.partitionWithKey (\t -> t ^. gt_size < 2) candidateTerms + (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 diff --git a/src/Gargantext/Core/Text/List/Social/Prelude.hs b/src/Gargantext/Core/Text/List/Social/Prelude.hs index f78c73f7f459036a18f72f1a090487812e653abe..f29d89ab317e2927b9d64b1dfeeb8c544f6ed735 100644 --- a/src/Gargantext/Core/Text/List/Social/Prelude.hs +++ b/src/Gargantext/Core/Text/List/Social/Prelude.hs @@ -44,14 +44,10 @@ instance (Ord a, Eq b) => Monoid (FlowCont a b) where mempty = FlowCont mempty mempty instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where - (<>) (FlowCont m1 s1) - (FlowCont m2 s2) - = FlowCont m s - where - m = Map.union m1 m2 - s | s1 == mempty = s2 - | s2 == mempty = s1 - | otherwise = Map.intersection s1 s2 + (<>) (FlowCont m1 s1) + (FlowCont m2 s2) + = FlowCont (m1 <> m2) + (s1 <> s2) makeLenses ''FlowCont diff --git a/src/Gargantext/Core/Text/List/Social/Scores.hs b/src/Gargantext/Core/Text/List/Social/Scores.hs index e4b234083ab758ed317a7fd6579b5e1e657c558e..743df8f38e00118ab5a340b4bbd39fc7a49d043f 100644 --- a/src/Gargantext/Core/Text/List/Social/Scores.hs +++ b/src/Gargantext/Core/Text/List/Social/Scores.hs @@ -44,7 +44,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me -> Map Text NgramsRepoElement -> FlowCont Text FlowListScores toFlowListScores_Level1 k' flc_origin' flc_dest ngramsRepo = - Set.foldl' (toFlowListScores_Level2 k' ngramsRepo flc_origin') + Set.foldl' (toFlowListScores_Level2 k' ngramsRepo flc_origin') flc_dest (Set.fromList $ Map.keys $ view flc_cont flc_origin') @@ -56,9 +56,15 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me -> FlowCont Text FlowListScores toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t = case Map.lookup t ngramsRepo of - Nothing -> over flc_cont (Map.union (Map.singleton t mempty)) flc_dest' - Just nre -> over flc_scores - ( (Map.alter (addParent k'' nre (Set.fromList $ Map.keys $ view flc_cont flc_origin'')) t) + Nothing -> over flc_cont (Map.union $ Map.singleton t mempty) flc_dest' + Just nre -> over flc_cont (Map.delete t) + $ over flc_scores + ( (Map.alter (addParent k'' nre ( Set.fromList + $ Map.keys + $ view flc_cont flc_origin'' + ) + ) t + ) . (Map.alter (addList $ _nre_list nre) t) ) flc_dest'