[docker] update image, add README info
[gargantext.git] / src / Gargantext / Text / List.hs
index 3bf97a886bd789adc57533d4f4cabb9a9facc16e..3d4173442fe9dc8046be592d5a1762a6b3b30db1 100644 (file)
@@ -17,7 +17,7 @@ module Gargantext.Text.List
   where
 
 import Data.Either (partitionEithers, Either(..))
-import Debug.Trace (trace)
+-- import Debug.Trace (trace)
 import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
@@ -61,7 +61,6 @@ buildNgramsLists :: Lang -> Int -> Int -> StopSize -> UserCorpusId -> MasterCorp
                  -> Cmd err (Map NgramsType [NgramsElement])
 buildNgramsLists l n m s uCid mCid = do
   ngTerms     <- buildNgramsTermsList l n m s uCid mCid
-  --ngTerms     <- buildNgramsTermsList' uCid (ngramsGroup l n m) (isStopTerm s . fst) 500 50
   othersTerms <- mapM (buildNgramsOthersList uCid identity) [Authors, Sources, Institutes]
   pure $ Map.unions $ othersTerms <> [ngTerms]
 
@@ -72,9 +71,12 @@ buildNgramsOthersList uCid groupIt nt = do
   ngs <- groupNodesByNgramsWith groupIt <$> getNodesByNgramsUser uCid nt
 
   let
-    all' = Map.toList ngs
-  pure $ (toElements GraphTerm all') <> (toElements CandidateTerm all')
-  --pure $ (toElements GraphTerm $ take 10 all') <> (toElements CandidateTerm $ drop 10 all')
+    listSize = 9
+    all' = List.reverse $ List.sortOn (Set.size . snd . snd) $ Map.toList ngs
+    graphTerms = List.take listSize all'
+    candiTerms = List.drop listSize all'
+  pure $ Map.unionsWith (<>) [ toElements GraphTerm     graphTerms
+                             , toElements CandidateTerm candiTerms]
     where
       toElements nType x = Map.fromList [(nt, [ mkNgramsElement t nType Nothing (mSetFromList [])
                             | (t,_ns) <- x
@@ -159,7 +161,7 @@ toList stop l n = case stop n of
 
 toTermList :: Int -> Int -> (a -> Bool) -> [a] -> [(ListType, a)]
 toTermList _ _ _ [] = []
-toTermList a b stop ns =  trace ("computing toTermList") $
+toTermList a b stop ns =  -- trace ("computing toTermList") $
                       map (toList stop CandidateTerm) xs
                    <> map (toList stop GraphTerm)     ys
                    <> toTermList a b stop zs