Commit a188045f authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Cont can be empty now.

parent 2e7ec2f4
...@@ -15,7 +15,6 @@ Portability : POSIX ...@@ -15,7 +15,6 @@ Portability : POSIX
module Gargantext.Core.Text.List module Gargantext.Core.Text.List
where where
import Control.Lens ((^.), view, over) import Control.Lens ((^.), view, over)
import Data.Map (Map) import Data.Map (Map)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
...@@ -94,12 +93,12 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do ...@@ -94,12 +93,12 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
$ List.zip (Map.keys ngs') $ List.zip (Map.keys ngs')
(List.cycle [mempty]) (List.cycle [mempty])
) )
{- {-
printDebug "flowSocialList'" printDebug "flowSocialList'"
$ Map.filter (not . ((==) Map.empty) . (view fls_parents)) $ Map.filter (not . ((==) Map.empty) . (view fls_parents))
$ view flc_scores socialLists' $ view flc_scores socialLists'
-} -}
let let
groupedWithList = toGroupedTreeText groupIt socialLists' ngs' groupedWithList = toGroupedTreeText groupIt socialLists' ngs'
...@@ -152,8 +151,8 @@ buildNgramsTermsList user uCid mCid groupParams = do ...@@ -152,8 +151,8 @@ buildNgramsTermsList user uCid mCid groupParams = do
groupedWithList = map (addListType (invertForw socialLists)) grouped groupedWithList = map (addListType (invertForw socialLists)) grouped
(stopTerms, candidateTerms) = Map.partition ((== Just StopTerm) . viewListType) groupedWithList (stopTerms, candidateTerms) = Map.partition ((== Just StopTerm) . viewListType) groupedWithList
(groupedMono, groupedMult) = Map.partition (\t -> t ^. gt_size < 2) candidateTerms (groupedMono, groupedMult) = Map.partition (\t -> t ^. gt_size < 2) candidateTerms
-- (groupedMono, groupedMult) = Map.partitionWithKey (\t -> t ^. gt_size < 2) candidateTerms -- (groupedMono, groupedMult) = Map.partitionWithKey (\t _v -> size t < 2) candidateTerms
-- printDebug "\n * stopTerms * \n" stopTerms -- printDebug "\n * stopTerms * \n" stopTerms
-- splitting monterms and multiterms to take proportional candidates -- splitting monterms and multiterms to take proportional candidates
......
...@@ -44,14 +44,10 @@ instance (Ord a, Eq b) => Monoid (FlowCont a b) where ...@@ -44,14 +44,10 @@ instance (Ord a, Eq b) => Monoid (FlowCont a b) where
mempty = FlowCont mempty mempty mempty = FlowCont mempty mempty
instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where
(<>) (FlowCont m1 s1) (<>) (FlowCont m1 s1)
(FlowCont m2 s2) (FlowCont m2 s2)
= FlowCont m s = FlowCont (m1 <> m2)
where (s1 <> s2)
m = Map.union m1 m2
s | s1 == mempty = s2
| s2 == mempty = s1
| otherwise = Map.intersection s1 s2
makeLenses ''FlowCont makeLenses ''FlowCont
......
...@@ -44,7 +44,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me ...@@ -44,7 +44,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
-> Map Text NgramsRepoElement -> Map Text NgramsRepoElement
-> FlowCont Text FlowListScores -> FlowCont Text FlowListScores
toFlowListScores_Level1 k' flc_origin' flc_dest ngramsRepo = 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 flc_dest
(Set.fromList $ Map.keys $ view flc_cont flc_origin') (Set.fromList $ Map.keys $ view flc_cont flc_origin')
...@@ -56,9 +56,15 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me ...@@ -56,9 +56,15 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
-> FlowCont Text FlowListScores -> FlowCont Text FlowListScores
toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t = toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t =
case Map.lookup t ngramsRepo of case Map.lookup t ngramsRepo of
Nothing -> over flc_cont (Map.union (Map.singleton t mempty)) flc_dest' Nothing -> over flc_cont (Map.union $ Map.singleton t mempty) flc_dest'
Just nre -> over flc_scores Just nre -> over flc_cont (Map.delete t)
( (Map.alter (addParent k'' nre (Set.fromList $ Map.keys $ view flc_cont flc_origin'')) 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) . (Map.alter (addList $ _nre_list nre) t)
) flc_dest' ) flc_dest'
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment