[FIX] FlowList last function written, compilation ok, testing now.

src/Gargantext/Core/Text/List.hs

@@ -144,7 +144,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
   socialLists' :: FlowCont Text FlowListScores
     <- flowSocialList' MySelfFirst user nt ( FlowCont Map.empty
                                                       $ Map.fromList
-                                                      $ List.zip (Map.keys allTerms)
+                                                      $ List.zip (Map.keys   allTerms)
                                                                  (List.cycle [mempty])
                                            )
   let groupedWithList = toGroupedTree groupParams socialLists' allTerms
@@ -183,9 +183,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
 
   let
     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)
+    groupedTreeScores_SetNodeId = setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
 
   -- | Coocurrences computation
   --, t1 >= t2 -- permute byAxis diag  -- since matrix symmetric
@@ -207,16 +205,13 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
                 $ scored' mapCooc
 
   let
-    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)
+    groupedTreeScores_SpeGen :: Map Text (GroupedTreeScores (Scored Text))
+    groupedTreeScores_SpeGen = setScoresWithMap (mapScores identity) (groupedMonoHead <> groupedMultHead)
 
   let
     -- sort / partition / split
     -- 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 = Map.partition (\g -> (view scored_genInc $ view gts'_score g)
@@ -236,6 +231,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
     splitAt' n' = (both (Map.fromList)) . (List.splitAt (round $ n' * listSizeLocal))
     sortOn   f  = (List.sortOn (Down . (view (gts'_score . f)) . snd)) . Map.toList
 
+
     monoInc_size = splitAt' $ monoSize * inclSize / 2
     (monoScoredInclHead, monoScoredInclTail) = monoInc_size $ (sortOn scored_genInc) monoScoredIncl
     (monoScoredExclHead, monoScoredExclTail) = monoInc_size $ (sortOn scored_speExc) monoScoredExcl
@@ -244,20 +240,23 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
     (multScoredInclHead, multScoredInclTail) = multExc_size $ (sortOn scored_genInc) multScoredIncl
     (multScoredExclHead, multScoredExclTail) = multExc_size $ (sortOn scored_speExc) multScoredExcl
 
+
+------------------------------------------------------------
+
     -- Final Step building the Typed list
     termListHead = maps <> cands
       where
         maps = setListType (Just MapTerm)
-            $   monoScoredInclHead
-             <> monoScoredExclHead
-             <> multScoredInclHead
-             <> multScoredExclHead
+            $  monoScoredInclHead
+            <> monoScoredExclHead
+            <> multScoredInclHead
+            <> multScoredExclHead
 
         cands = setListType (Just CandidateTerm)
-             $   monoScoredInclTail
-              <> monoScoredExclTail
-              <> multScoredInclTail
-              <> multScoredExclTail
+             $  monoScoredInclTail
+             <> monoScoredExclTail
+             <> multScoredInclTail
+             <> multScoredExclTail
 
     termListTail = (setListType (Just CandidateTerm)) (groupedMonoTail <> groupedMultTail)
 

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

@@ -53,25 +53,32 @@ toGroupedTree groupParams flc scores = {-view flc_scores-} flow2
         False -> groupWithStem' groupParams flow1
 
 
+
+------------------------------------------------------------------------
+setScoresWithMap :: (Ord a, Ord b, Monoid b) => Map Text b
+                 -> Map Text (GroupedTreeScores a)
+                 -> Map Text (GroupedTreeScores b)
+setScoresWithMap m = setScoresWith (score m)
+  where
+    score m t = case Map.lookup t m of
+      Nothing -> mempty
+      Just  r -> r
+
 setScoresWith :: (Ord a, Ord b)
-              =>  (Text -> (GroupedTreeScores a) -> (GroupedTreeScores b))
+              => (Text -> b)
               -> Map Text (GroupedTreeScores a)
               -> Map Text (GroupedTreeScores b)
-setScoresWith = Map.mapWithKey
-
 {-
-gts :: (Text -> b) -> Text -> GroupedTreeScores a -> GroupedTreeScores b
-gts f t g = over gts'_children set gts'_score (f t) g
+-- | This Type level lenses solution does not work
+setScoresWith f = Map.mapWithKey (\k v -> over gts'_children (setScoresWith f)
+                                       $  set  gts'_score    (f k) v
+                                 )
 -}
+setScoresWith f = Map.mapWithKey (\k v -> v { _gts'_score    = f k
+                                            , _gts'_children = setScoresWith f
+                                                             $ view gts'_children v
+                                            }
+                                 )
 
-{-
-Map.foldlWithKey (\k v ->
-                                   {- over gts'_children (setScoresWith fun)
-                                          $ over gts'_score    (fun k)
-                                          -}
-                                          set gts'_score Set.empty -- (fun k)
-                                          v
-                                   ) mempty m
--}
 
 ------------------------------------------------------------------------

src/Gargantext/Core/Text/Metrics.hs

@@ -20,6 +20,8 @@ module Gargantext.Core.Text.Metrics
 --import Math.KMeans (kmeans, euclidSq, elements)
 import Control.Lens (makeLenses)
 import Data.Map (Map)
+import Data.Semigroup (Semigroup, (<>))
+import Data.Monoid (Monoid, mempty)
 import Gargantext.Prelude
 import Gargantext.Core.Methods.Distances.Accelerate.SpeGen
 import Gargantext.Core.Viz.Graph.Index
@@ -49,6 +51,15 @@ data Scored ts = Scored
   , _scored_speExc :: !SpecificityExclusion
   } deriving (Show, Eq, Ord)
 
+instance Monoid a => Monoid (Scored a) where
+  mempty = Scored mempty mempty mempty
+
+instance Semigroup a => Semigroup (Scored a) where
+  (<>) (Scored a  b  c )
+       (Scored _a' b' c')
+      = Scored (a {-<> a'-})
+               (b <> b')
+               (c <> c')
 
 localMetrics' :: Ord t => Map (t,t) Int -> Map t (Vec.Vector Double)
 localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [inc,spe]))

src/Gargantext/Prelude.hs

@@ -316,10 +316,23 @@ foldM' f z (x:xs) = do
   z' `seq` foldM' f z' xs
 
 -----------------------------------------------------------------------
-
+-- | Instance for basic numerals
+-- See the difference between Double and (Int Or Integer)
 instance Monoid Double where
-  mempty = 0
+  mempty = 1
 
 instance Semigroup Double where
   (<>) a b = a * b
 
+-----------
+instance Monoid Int where
+  mempty = 0
+
+instance Semigroup Int where
+  (<>) a b = a + b
+----
+instance Monoid Integer where
+  mempty = 0
+
+instance Semigroup Integer where
+  (<>) a b = a + b