Merge branch 'dev-phylo' of...

Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-merge

src/Gargantext/Core/Viz/AdaptativePhylo.hs

@@ -262,14 +262,15 @@ type Cooc =  Map (Int,Int) Double
 --  param : the parameters of the phylomemy (with the user's configuration)
 --  periods : the temporal steps of a phylomemy
 data Phylo =
-     Phylo { _phylo_foundations :: PhyloFoundations
-           , _phylo_timeCooc    :: !(Map Date Cooc)
-           , _phylo_timeDocs    :: !(Map Date Double)
-           , _phylo_termFreq    :: !(Map Int Double)
-           , _phylo_horizon     :: !(Map (PhyloGroupId,PhyloGroupId) Double)           
-           , _phylo_groupsProxi :: !(Map (PhyloGroupId,PhyloGroupId) Double)
-           , _phylo_param       :: PhyloParam
-           , _phylo_periods     :: Map PhyloPeriodId PhyloPeriod
+     Phylo { _phylo_foundations  :: PhyloFoundations
+           , _phylo_timeCooc     :: !(Map Date Cooc)
+           , _phylo_timeDocs     :: !(Map Date Double)
+           , _phylo_termFreq     :: !(Map Int Double)
+           , _phylo_lastTermFreq :: !(Map Int Double)           
+           , _phylo_horizon      :: !(Map (PhyloGroupId,PhyloGroupId) Double)           
+           , _phylo_groupsProxi  :: !(Map (PhyloGroupId,PhyloGroupId) Double)
+           , _phylo_param        :: PhyloParam
+           , _phylo_periods      :: Map PhyloPeriodId PhyloPeriod
            }
            deriving (Generic, Show, Eq)
 

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -46,7 +46,7 @@ cooc2graph' distance threshold myCooc = distanceMap
   where
     (ti, _) = createIndices myCooc
     myCooc' = toIndex ti myCooc
-    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 0) myCooc'
     distanceMat = measure distance matCooc
     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 

src/Gargantext/Core/Viz/Phylo/PhyloExport.hs

@@ -138,7 +138,11 @@ groupToDotNode fdt g bId =
                          , toAttr "to"   (pack $ show (snd $ g ^. phylo_groupPeriod))
                          , toAttr "branchId" (pack $ unwords (init $ map show $ snd $ g ^. phylo_groupBranchId))
                          , toAttr "bId" (pack $ show bId)
-                         , toAttr "support" (pack $ show (g ^. phylo_groupSupport))])  
+                         , toAttr "support" (pack $ show (g ^. phylo_groupSupport))
+                         , toAttr "label" (pack $ show (ngramsToLabel fdt (g ^. phylo_groupNgrams)))
+                         , toAttr "foundation" (pack $ show (idxToLabel (g ^. phylo_groupNgrams)))
+                         , toAttr "role" (pack $ show (idxToLabel' ((g ^. phylo_groupMeta) ! "dynamics")))
+                         ])  
 
 
 toDotEdge :: DotId -> DotId -> Text.Text -> EdgeType -> Dot DotId
@@ -192,6 +196,7 @@ exportToDot phylo export =
                      ,(toAttr (fromStrict "phyloPeriods") $ pack $ show (length $ elems $ phylo ^. phylo_periods))
                      ,(toAttr (fromStrict "phyloBranches") $ pack $ show (length $ export ^. export_branches))
                      ,(toAttr (fromStrict "phyloGroups") $ pack $ show (length $ export ^. export_groups))
+                     ,(toAttr (fromStrict "phyloTermsFreq") $ pack $ show (toList $ _phylo_lastTermFreq phylo))
                      ])
 
 {-

src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs

@@ -202,7 +202,7 @@ toPhyloClique phylo phyloDocs = case (clique $ getConfig phylo) of
                                              $ foldl sumCooc empty
                                              $ map listToMatrix 
                                              $ map (\d -> ngramsToIdx (text d) (getRoots phylo)) docs
-                                     in (prd, map (\cl -> PhyloClique cl 0 prd) $ getMaxCliques Conditional 0.001 cooc)) 
+                                     in (prd, map (\cl -> PhyloClique cl 0 prd) $ getMaxCliques Conditional 0 cooc)) 
                                $ toList phyloDocs
                           mcl' = mcl `using` parList rdeepseq                               
                        in fromList mcl' 
@@ -286,6 +286,17 @@ docsToTermFreq docs fdt =
       sumFreqs = sum $ elems freqs
    in map (/sumFreqs) freqs
 
+docsToLastTermFreq :: Int -> [Document] -> Vector Ngrams -> Map Int Double
+docsToLastTermFreq n docs fdt = 
+  let last   = take n $ reverse $ sort $ map date docs
+      nbDocs = fromIntegral $ length $ filter (\d -> elem (date d) last) docs
+      freqs  = map (/(nbDocs))
+             $ fromList
+             $ map (\lst -> (head' "docsToLastTermFreq" lst, fromIntegral $ length lst)) 
+             $ group $ sort $ concat $ map (\d -> nub $ ngramsToIdx (text d) fdt) $ filter (\d -> elem (date d) last) docs
+      sumFreqs = sum $ elems freqs
+   in map (/sumFreqs) freqs  
+
 
 --  To count the number of docs by unit of time
 docsToTimeScaleNb :: [Document] -> Map Date Double
@@ -312,6 +323,7 @@ toPhyloBase docs lst conf =
                (docsToTimeScaleCooc docs (foundations ^. foundations_roots))
                (docsToTimeScaleNb docs)
                (docsToTermFreq docs (foundations ^. foundations_roots))
+               (docsToLastTermFreq (getTimePeriod $ timeUnit conf) docs (foundations ^. foundations_roots))
                empty
                empty
                params

src/Gargantext/Core/Viz/Phylo/PhyloTools.hs

@@ -17,7 +17,7 @@ import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tai
 import Data.Set (Set, disjoint)
 import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
 import Data.String (String)
-import Data.Text (Text, unwords)
+import Data.Text (Text)
 
 import Gargantext.Prelude
 import Gargantext.Core.Viz.AdaptativePhylo
@@ -31,6 +31,7 @@ import qualified Data.Vector as Vector
 import qualified Data.List as List
 import qualified Data.Set as Set
 import qualified Data.Map as Map
+import qualified Data.Text as Text
 
 ------------
 -- | Io | --
@@ -98,8 +99,13 @@ ngramsToIdx ns fdt = map (\n -> fromJust $ elemIndex n fdt) ns
 
 -- | To transform a list of Ngrams Indexes into a Label
 ngramsToLabel :: Vector Ngrams -> [Int] -> Text
-ngramsToLabel ngrams l = unwords $ tail' "ngramsToLabel" $ concat $ map (\n -> ["|",n]) $ ngramsToText ngrams l
+ngramsToLabel ngrams l = Text.unwords $ tail' "ngramsToLabel" $ concat $ map (\n -> ["|",n]) $ ngramsToText ngrams l
 
+idxToLabel :: [Int] -> String
+idxToLabel l = List.unwords $ tail' "idxToLabel" $ concat $ map (\n -> ["|",show n]) l
+
+idxToLabel' :: [Double] -> String
+idxToLabel' l = List.unwords $ tail' "idxToLabel" $ concat $ map (\n -> ["|",show n]) l
 
 -- | To transform a list of Ngrams Indexes into a list of Text
 ngramsToText :: Vector Ngrams -> [Int] -> [Text]