[DEBUG] Message
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / PhyloMaker.hs
index 4245ab8e4c576aa0b9ac598c1cd9ab5bc1ff9868..a7b3a7b7d3b3d99c31cc2ac35fb03060c96960ea 100644 (file)
@@ -8,133 +8,210 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-
 module Gargantext.Core.Viz.Phylo.PhyloMaker where
 
+import Control.DeepSeq (NFData)
+import Control.Lens hiding (Level)
+import Control.Parallel.Strategies (parList, rdeepseq, using)
 import Data.List (concat, nub, partition, sort, (++), group, intersect, null, sortOn, groupBy, tail)
-import Data.Map (Map, fromListWith, keys, unionWith, fromList, empty, toList, elems, (!), restrictKeys, foldlWithKey, insert)
+import Data.Map.Strict (Map, fromListWith, keys, unionWith, fromList, empty, toList, elems, (!), restrictKeys, foldlWithKey, insert)
+import Data.Set (Set)
+import Data.Text (Text)
 import Data.Vector (Vector)
+import Debug.Trace (trace)
+import Prelude (floor)
 
-import Gargantext.Prelude
-import Gargantext.Core.Viz.AdaptativePhylo
+import Gargantext.Core.Methods.Similarities (Similarity(Conditional))
+import Gargantext.Core.Methods.Graph.MaxClique (getMaxCliques)
+import Gargantext.Core.Text.Context (TermList)
+import Gargantext.Core.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, fisWithSizePolyMap', Size(..))
+import Gargantext.Core.Viz.Phylo
+import Gargantext.Core.Viz.Phylo.PhyloExport (toHorizon)
 import Gargantext.Core.Viz.Phylo.PhyloTools
-import Gargantext.Core.Viz.Phylo.TemporalMatching (adaptativeTemporalMatching, constanteTemporalMatching, getNextPeriods, filterDocs, filterDiago, reduceDiagos, toProximity)
 import Gargantext.Core.Viz.Phylo.SynchronicClustering (synchronicClustering)
-import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, Size(..))
-import Gargantext.Core.Viz.Graph.MaxClique (getMaxCliques)
-import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional))
-
-import Control.DeepSeq (NFData)
-import Control.Parallel.Strategies (parList, rdeepseq, using)
-import Debug.Trace (trace)
-import Control.Lens hiding (Level)
+import Gargantext.Core.Viz.Phylo.TemporalMatching (temporalMatching, getNextPeriods, filterDocs, filterDiago, reduceDiagos, toProximity)
+import Gargantext.Prelude
 
-import qualified Data.Vector as Vector
 import qualified Data.Set as Set
+import qualified Data.Vector as Vector
 
 ------------------
 -- | To Phylo | --
 ------------------
 
+{-
+-- TODO AD
+data Phylo' = PhyloBase { _phylo'_phyloBase :: Phylo}
+            | PhyloN    { _phylo'_flatPhylo :: Phylo}
+
 
-toPhylo :: [Document] -> TermList -> Config -> Phylo
-toPhylo docs lst conf = trace ("# phylo1 groups " <> show(length $ getGroupsFromLevel 1 phylo1))
-                      $ traceToPhylo (phyloLevel conf) $
-    if (phyloLevel conf) > 1
-      then foldl' (\phylo' _ -> synchronicClustering phylo') phylo1 [2..(phyloLevel conf)]
-      else phylo1 
+toPhylo' :: Phylo' -> [Document] -> TermList -> PhyloConfig -> Phylo
+toPhylo' (PhyloN    phylo) = toPhylo'
+toPhylo' (PhyloBase phylo) = toPhylo
+-}
+
+-- TODO an adaptative synchronic clustering with a slider
+
+toPhylo :: Phylo -> Phylo
+toPhylo phylowithoutLink = trace ("# flatPhylo groups " <> show(length $ getGroupsFromScale 1 flatPhylo))
+                      $ traceToPhylo (phyloScale $ getConfig phylowithoutLink) $
+    if (phyloScale $ getConfig phylowithoutLink) > 1
+      then foldl' (\phylo' _ -> synchronicClustering phylo') phyloAncestors [2..(phyloScale $ getConfig phylowithoutLink)]
+      else phyloAncestors
     where
         --------------------------------------
-        phylo1 :: Phylo
-        phylo1 = toPhylo1 docs phyloBase
+        phyloAncestors :: Phylo
+        phyloAncestors =
+            if (findAncestors $ getConfig phylowithoutLink)
+              then toHorizon flatPhylo
+              else flatPhylo
         --------------------------------------
-        phyloBase :: Phylo 
-        phyloBase = toPhyloBase docs lst conf
+        flatPhylo :: Phylo
+        flatPhylo = addTemporalLinksToPhylo phylowithoutLink
         --------------------------------------
 
 
+-----------------------------
+-- | Create a flat Phylo | --
+-----------------------------
+
+{-
+-- create an adaptative diachronic 'sea elevation' ladder
+-}
+adaptDiachronicLadder :: Double -> Set Double -> Set Double -> [Double]
+adaptDiachronicLadder curr similarities ladder =
+  if curr <= 0 || Set.null similarities
+    then Set.toList ladder
+    else
+      let idx = ((Set.size similarities) `div` (floor curr)) - 1
+          thr = Set.elemAt idx similarities
+      -- we use a sliding methods 1/10, then 1/9, then ... 1/2
+      in adaptDiachronicLadder (curr -1) (Set.filter (> thr) similarities) (Set.insert thr ladder)
+
+
+{-
+-- create a constante diachronic 'sea elevation' ladder
+-}
+constDiachronicLadder :: Double -> Double -> Set Double -> [Double]
+constDiachronicLadder curr step ladder =
+  if curr > 1
+    then Set.toList ladder
+    else constDiachronicLadder (curr + step) step (Set.insert curr ladder)
 
---------------------
--- | To Phylo 1 | --
---------------------
 
-toGroupsProxi :: Level -> Phylo -> Phylo
-toGroupsProxi lvl phylo = 
+{-
+-- process an initial scanning of the kinship links
+-}
+scanSimilarity :: Scale -> Phylo -> Phylo
+scanSimilarity lvl phylo =
   let proximity = phyloProximity $ getConfig phylo
-      groupsProxi = foldlWithKey (\acc pId pds -> 
+      scanning  = foldlWithKey (\acc pId pds ->
                       -- 1) process period by period
                       let egos = map (\g -> (getGroupId g, g ^. phylo_groupNgrams))
-                               $ elems 
-                               $ view ( phylo_periodLevels 
-                                      . traverse . filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl) 
-                                      . phylo_levelGroups ) pds
+                               $ elems
+                               $ view ( phylo_periodScales
+                                      . traverse . filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == lvl)
+                                      . phylo_scaleGroups ) pds
                           next    = getNextPeriods ToParents (getTimeFrame $ timeUnit $ getConfig phylo) pId (keys $ phylo ^. phylo_periods)
-                          targets = map (\g ->  (getGroupId g, g ^. phylo_groupNgrams)) $ getGroupsFromLevelPeriods lvl next phylo
+                          targets = map (\g ->  (getGroupId g, g ^. phylo_groupNgrams)) $ getGroupsFromScalePeriods lvl next phylo
                           docs    = filterDocs  (phylo ^. phylo_timeDocs) ([pId] ++ next)
                           diagos  = filterDiago (phylo ^. phylo_timeCooc) ([pId] ++ next)
                           -- 2) compute the pairs in parallel
-                          pairs  = map (\(id,ngrams) -> 
-                                        map (\(id',ngrams') -> 
+                          pairs  = map (\(id,ngrams) ->
+                                        map (\(id',ngrams') ->
                                             let nbDocs = (sum . elems) $ filterDocs docs    ([idToPrd id, idToPrd id'])
                                                 diago  = reduceDiagos  $ filterDiago diagos ([idToPrd id, idToPrd id'])
                                              in ((id,id'),toProximity nbDocs diago proximity ngrams ngrams' ngrams')
-                                        ) $ filter (\(_,ngrams') -> (not . null) $ intersect ngrams ngrams') targets 
+                                        ) $ filter (\(_,ngrams') -> (not . null) $ intersect ngrams ngrams') targets
                                  ) egos
                           pairs' = pairs `using` parList rdeepseq
                        in acc ++ (concat pairs')
                     ) [] $ phylo ^. phylo_periods
-   in phylo & phylo_groupsProxi .~ ((traceGroupsProxi . fromList) groupsProxi) 
+   in phylo & phylo_diaSimScan .~ Set.fromList (traceGroupsProxi $ map snd scanning)
+
 
 
-appendGroups :: (a -> PhyloPeriodId -> Level -> Int -> [Cooc] -> PhyloGroup) -> Level -> Map (Date,Date) [a] -> Phylo -> Phylo
+appendGroups :: (a -> Period -> (Text,Text) -> Scale -> Int -> [Cooc] -> PhyloGroup) -> Scale -> Map (Date,Date) [a] -> Phylo -> Phylo
 appendGroups f lvl m phylo =  trace ("\n" <> "-- | Append " <> show (length $ concat $ elems m) <> " groups to Level " <> show (lvl) <> "\n")
     $ over ( phylo_periods
            .  traverse
-           . phylo_periodLevels
+           . phylo_periodScales
            .  traverse)
-           (\phyloLvl -> if lvl == (phyloLvl ^. phylo_levelLevel)
+           (\phyloLvl -> if lvl == (phyloLvl ^. phylo_scaleScale)
                          then
-                            let pId = phyloLvl ^. phylo_levelPeriod
+                            let pId  = phyloLvl ^. phylo_scalePeriod
+                                pId' = phyloLvl ^. phylo_scalePeriodStr
                                 phyloCUnit = m ! pId
-                            in  phyloLvl 
-                              & phylo_levelGroups .~ (fromList $ foldl (\groups obj ->
+                            in  phyloLvl
+                              & phylo_scaleGroups .~ (fromList $ foldl (\groups obj ->
                                     groups ++ [ (((pId,lvl),length groups)
-                                              , f obj pId lvl (length groups)
+                                              , f obj pId pId' lvl (length groups)
                                                   (elems $ restrictKeys (phylo ^. phylo_timeCooc) $ periodsToYears [pId]))
                                               ] ) [] phyloCUnit)
-                         else 
+                         else
                             phyloLvl )
-           phylo  
+           phylo
 
 
-cliqueToGroup :: PhyloClique -> PhyloPeriodId -> Level ->  Int -> [Cooc] -> PhyloGroup
-cliqueToGroup fis pId lvl idx coocs = PhyloGroup pId lvl idx ""
-                   (fis ^. phyloClique_support)
-                   (fis ^. phyloClique_nodes)
-                   (ngramsToCooc (fis ^. phyloClique_nodes) coocs)
+clusterToGroup :: Clustering -> Period -> (Text,Text) -> Scale ->  Int -> [Cooc] -> PhyloGroup
+clusterToGroup fis pId pId' lvl idx coocs = PhyloGroup pId pId' lvl idx ""
+                   (fis ^. clustering_support )
+                   (fis ^. clustering_visWeighting)
+                   (fis ^. clustering_visFiltering)
+                   (fis ^. clustering_roots)
+                   (ngramsToCooc (fis ^. clustering_roots) coocs)
                    (1,[0]) -- branchid (lvl,[path in the branching tree])
                    (fromList [("breaks",[0]),("seaLevels",[0])])
-                   [] [] [] [] []
+                   [] [] [] [] [] [] []
+
+{-
+-- enhance the phylo with temporal links
+-}
+addTemporalLinksToPhylo :: Phylo -> Phylo
+addTemporalLinksToPhylo phylowithoutLink = case strategy of
+    Constante start gap -> temporalMatching (constDiachronicLadder start gap Set.empty) phylowithoutLink
+    Adaptative steps    -> temporalMatching (adaptDiachronicLadder steps (phylowithoutLink ^. phylo_diaSimScan) Set.empty) phylowithoutLink
+  where
+    strategy :: SeaElevation
+    strategy = getSeaElevation phylowithoutLink
+
+-----------------------
+-- | To Phylo Step | --
+-----------------------
 
 
-toPhylo1 :: [Document] -> Phylo -> Phylo
-toPhylo1 docs phyloBase = case (getSeaElevation phyloBase) of 
-    Constante start gap -> constanteTemporalMatching  start gap 
-                   $ appendGroups cliqueToGroup 1 phyloClique phyloBase    
-    Adaptative steps    -> adaptativeTemporalMatching steps
-                   $ toGroupsProxi 1
-                   $ appendGroups cliqueToGroup 1 phyloClique phyloBase
+indexDates' :: Map (Date,Date) [Document] -> Map (Date,Date) (Text,Text)
+indexDates' m = map (\docs ->
+  let ds = map (\d -> date' d) docs
+      f = if (null ds)
+            then ""
+            else toFstDate ds
+      l = if (null ds)
+            then ""
+            else toLstDate ds
+   in (f,l)) m
+
+
+-- To build the first phylo step from docs and terms
+-- QL: backend entre phyloBase et Clustering
+-- tophylowithoutLink
+toPhyloWithoutLink :: [Document] -> TermList -> PhyloConfig -> Phylo
+toPhyloWithoutLink docs lst conf = case (getSeaElevation phyloBase) of
+    Constante  _ _ -> appendGroups clusterToGroup 1 seriesOfClustering (updatePeriods (indexDates' docs') phyloBase)
+    Adaptative _   -> scanSimilarity 1
+                    $ appendGroups clusterToGroup 1 seriesOfClustering (updatePeriods (indexDates' docs') phyloBase)
     where
         --------------------------------------
-        phyloClique :: Map (Date,Date) [PhyloClique]
-        phyloClique =  toPhyloClique phyloBase docs'
+        seriesOfClustering :: Map (Date,Date) [Clustering]
+        seriesOfClustering =  toSeriesOfClustering phyloBase docs'
         --------------------------------------
         docs' :: Map (Date,Date) [Document]
+        -- QL: Time Consuming here
         docs' =  groupDocsByPeriodRec date (getPeriodIds phyloBase) (sortOn date docs) empty
-        -- docs' =  groupDocsByPeriod' date (getPeriodIds phyloBase) docs
         --------------------------------------
-
+        phyloBase :: Phylo
+        phyloBase = initPhylo docs lst conf
+        --------------------------------------
 
 ---------------------------
 -- | Frequent Item Set | --
@@ -142,71 +219,77 @@ toPhylo1 docs phyloBase = case (getSeaElevation phyloBase) of
 
 
 --  To apply a filter with the possibility of keeping some periods non empty (keep : True|False)
-filterClique :: Bool -> Int -> (Int -> [PhyloClique] -> [PhyloClique]) -> Map (Date, Date) [PhyloClique] -> Map (Date, Date) [PhyloClique]
+filterClique :: Bool -> Int -> (Int -> [Clustering] -> [Clustering]) -> Map (Date, Date) [Clustering] -> Map (Date, Date) [Clustering]
 filterClique keep thr f m = case keep of
   False -> map (\l -> f thr l) m
   True  -> map (\l -> keepFilled (f) thr l) m
 
 
 --  To filter Fis with small Support
-filterCliqueBySupport :: Int -> [PhyloClique] -> [PhyloClique]
-filterCliqueBySupport thr l = filter (\clq -> (clq ^. phyloClique_support) >= thr) l
+filterCliqueBySupport :: Int -> [Clustering] -> [Clustering]
+filterCliqueBySupport thr l = filter (\clq -> (clq ^. clustering_support ) >= thr) l
 
 
 --  To filter Fis with small Clique size
-filterCliqueBySize :: Int -> [PhyloClique] -> [PhyloClique]
-filterCliqueBySize thr l = filter (\clq -> (length $ clq ^. phyloClique_nodes) >= thr) l
+filterCliqueBySize :: Int -> [Clustering] -> [Clustering]
+filterCliqueBySize thr l = filter (\clq -> (length $ clq ^. clustering_roots) >= thr) l
 
 
 --  To filter nested Fis
-filterCliqueByNested :: Map (Date, Date) [PhyloClique] -> Map (Date, Date) [PhyloClique]
-filterCliqueByNested m = 
-  let clq  = map (\l -> 
-                foldl (\mem f -> if (any (\f' -> isNested (f' ^. phyloClique_nodes) (f ^. phyloClique_nodes)) mem)
+filterCliqueByNested :: Map (Date, Date) [Clustering] -> Map (Date, Date) [Clustering]
+filterCliqueByNested m =
+  let clq  = map (\l ->
+                foldl (\mem f -> if (any (\f' -> isNested (f' ^. clustering_roots) (f ^. clustering_roots)) mem)
                                  then mem
-                                 else 
-                                    let fMax = filter (\f' -> not $ isNested (f ^. phyloClique_nodes) (f' ^. phyloClique_nodes)) mem
+                                 else
+                                    let fMax = filter (\f' -> not $ isNested (f ^. clustering_roots) (f' ^. clustering_roots)) mem
                                     in  fMax ++ [f] ) [] l)
-           $ elems m 
+           $ elems m
       clq' = clq `using` parList rdeepseq
-  in  fromList $ zip (keys m) clq' 
+  in  fromList $ zip (keys m) clq'
 
 
 -- | To transform a time map of docs into a time map of Fis with some filters
-toPhyloClique :: Phylo -> Map (Date, Date) [Document] -> Map (Date,Date) [PhyloClique]
-toPhyloClique phylo phyloDocs = case (clique $ getConfig phylo) of 
+toSeriesOfClustering :: Phylo -> Map (Date, Date) [Document] -> Map (Date,Date) [Clustering]
+toSeriesOfClustering phylo phyloDocs = case (clique $ getConfig phylo) of
     Fis s s'    -> -- traceFis "Filtered Fis"
-                   filterCliqueByNested 
+                   filterCliqueByNested
                  {- \$ traceFis "Filtered by clique size" -}
                  $ filterClique True s' (filterCliqueBySize)
                  {- \$ traceFis "Filtered by support" -}
                  $ filterClique True s (filterCliqueBySupport)
                  {- \$ traceFis "Unfiltered Fis" -}
-                 phyloClique
-    MaxClique s -> filterClique True s (filterCliqueBySize)
-                 phyloClique
+                 seriesOfClustering
+    MaxClique s _ _ -> filterClique True s (filterCliqueBySize)
+                       seriesOfClustering
     where
-        -------------------------------------- 
-        phyloClique :: Map (Date,Date) [PhyloClique]
-        phyloClique = case (clique $ getConfig phylo) of 
-          Fis _ _     ->  
-                      let fis  = map (\(prd,docs) -> 
-                                  let lst = toList $ fisWithSizePolyMap (Segment 1 20) 1 (map (\d -> ngramsToIdx (text d) (getRoots phylo)) docs)
-                                   in (prd, map (\f -> PhyloClique (Set.toList $ fst f) (snd f) prd) lst))
+        --------------------------------------
+        seriesOfClustering :: Map (Date,Date) [Clustering]
+        seriesOfClustering = case (clique $ getConfig phylo) of
+          Fis _ _     ->
+                      let fis  = map (\(prd,docs) ->
+                                      case (corpusParser $ getConfig phylo) of
+                                        Csv' _  -> let lst = toList
+                                                                  $ fisWithSizePolyMap' (Segment 1 20) 1 (map (\d -> (ngramsToIdx (text d) (getRoots phylo), (weight d, (sourcesToIdx (sources d) (getSources phylo))))) docs)
+                                                           in (prd, map (\f -> Clustering (Set.toList $ fst f) ((fst . snd) f) prd ((fst . snd . snd) f) (((snd . snd . snd) f))) lst)
+                                        _  -> let lst = toList
+                                                      $ fisWithSizePolyMap (Segment 1 20) 1 (map (\d -> ngramsToIdx (text d) (getRoots phylo)) docs)
+                                              in (prd, map (\f -> Clustering (Set.toList $ fst f) (snd f) prd (Just $ fromIntegral $ snd f) []) lst)
+                                      )
                                $ toList phyloDocs
                           fis' = fis `using` parList rdeepseq
                        in fromList fis'
-          MaxClique _ -> 
-                      let mcl  = map (\(prd,docs) -> 
+          MaxClique _ thr filterType ->
+                      let mcl  = map (\(prd,docs) ->
                                     let cooc = map round
                                              $ foldl sumCooc empty
-                                             $ map listToMatrix 
+                                             $ 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 -> Clustering cl 0 prd Nothing []) $ getMaxCliques filterType Conditional thr cooc))
                                $ toList phyloDocs
-                          mcl' = mcl `using` parList rdeepseq                               
-                       in fromList mcl' 
-        -------------------------------------- 
+                          mcl' = mcl `using` parList rdeepseq
+                       in fromList mcl'
+        --------------------------------------
 
         -- dev viz graph maxClique getMaxClique
 
@@ -216,9 +299,9 @@ toPhyloClique phylo phyloDocs = case (clique $ getConfig phylo) of
 --------------------
 
 
---  To transform the docs into a time map of coocurency matrix 
+--  To transform the docs into a time map of coocurency matrix
 docsToTimeScaleCooc :: [Document] -> Vector Ngrams -> Map Date Cooc
-docsToTimeScaleCooc docs fdt = 
+docsToTimeScaleCooc docs fdt =
     let mCooc  = fromListWith sumCooc
                $ map (\(_d,l) -> (_d, listToMatrix l))
                $ map (\doc -> (date doc, sort $ ngramsToIdx (text doc) fdt)) docs
@@ -232,12 +315,12 @@ docsToTimeScaleCooc docs fdt =
 -----------------------
 -- | to Phylo Base | --
 -----------------------
-
+-- TODO anoe
 groupDocsByPeriodRec :: (NFData doc, Ord date, Enum date) => (doc -> date) -> [(date,date)] -> [doc] -> Map (date, date) [doc] -> Map (date, date) [doc]
-groupDocsByPeriodRec f prds docs acc = 
+groupDocsByPeriodRec f prds docs acc =
     if ((null prds) || (null docs))
-      then acc 
-      else 
+      then acc
+      else
         let prd = head' "groupBy" prds
             docs' = partition (\d -> (f d >= fst prd) && (f d <= snd prd)) docs
          in groupDocsByPeriodRec f (tail prds) (snd docs') (insert prd (fst docs') acc)
@@ -245,11 +328,11 @@ groupDocsByPeriodRec f prds docs acc =
 
 --  To group a list of Documents by fixed periods
 groupDocsByPeriod' :: (NFData doc, Ord date, Enum date) => (doc -> date) -> [(date,date)] -> [doc] -> Map (date, date) [doc]
-groupDocsByPeriod' f pds docs = 
+groupDocsByPeriod' f pds docs =
   let docs'    = groupBy (\d d' -> f d == f d') $ sortOn f docs
       periods  = map (inPeriode f docs') pds
       periods' = periods `using` parList rdeepseq
-   in trace ("\n" <> "-- | Group " <> show(length docs) <> " docs by " <> show(length pds) <> " periods" <> "\n") 
+   in trace ("\n" <> "-- | Group " <> show(length docs) <> " docs by " <> show(length pds) <> " periods" <> "\n")
     $ fromList $ zip pds periods'
   where
     --------------------------------------
@@ -262,18 +345,18 @@ groupDocsByPeriod' f pds docs =
 --  To group a list of Documents by fixed periods
 groupDocsByPeriod :: (NFData doc, Ord date, Enum date) => (doc -> date) -> [(date,date)] -> [doc] -> Map (date, date) [doc]
 groupDocsByPeriod _ _   [] = panic "[ERR][Viz.Phylo.PhyloMaker] Empty [Documents] can not have any periods"
-groupDocsByPeriod f pds es = 
+groupDocsByPeriod f pds es =
   let periods  = map (inPeriode f es) pds
       periods' = periods `using` parList rdeepseq
 
-  in  trace ("\n" <> "-- | Group " <> show(length es) <> " docs by " <> show(length pds) <> " periods" <> "\n") 
+  in  trace ("\n" <> "-- | Group " <> show(length es) <> " docs by " <> show(length pds) <> " periods" <> "\n")
     $ fromList $ zip pds periods'
   where
     --------------------------------------
     inPeriode :: Ord b => (t -> b) -> [t] -> (b, b) -> [t]
     inPeriode f' h (start,end) =
       fst $ partition (\d -> f' d >= start && f' d <= end) h
-    --------------------------------------   
+    --------------------------------------
 
 
 docsToTermFreq :: [Document] -> Vector Ngrams -> Map Int Double
@@ -281,38 +364,54 @@ docsToTermFreq docs fdt =
   let nbDocs = fromIntegral $ length docs
       freqs = map (/(nbDocs))
              $ fromList
-             $ map (\lst -> (head' "docsToTermFreq" lst, fromIntegral $ length lst)) 
+             $ map (\lst -> (head' "docsToTermFreq" lst, fromIntegral $ length lst))
              $ group $ sort $ concat $ map (\d -> nub $ ngramsToIdx (text d) fdt) docs
       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
-docsToTimeScaleNb docs = 
+docsToTimeScaleNb docs =
     let docs' = fromListWith (+) $ map (\d -> (date d,1)) docs
         time  = fromList $ map (\t -> (t,0)) $ toTimeScale (keys docs') 1
-    in  trace ("\n" <> "-- | Group " <> show(length docs) <> " docs by " <> show(length time) <> " unit of time" <> "\n") 
+    in  trace ("\n" <> "-- | Group " <> show(length docs) <> " docs by " <> show(length time) <> " unit of time" <> "\n")
       $ unionWith (+) time docs'
 
 
-initPhyloLevels :: Int -> PhyloPeriodId -> Map PhyloLevelId PhyloLevel
-initPhyloLevels lvlMax pId = 
-    fromList $ map (\lvl -> ((pId,lvl),PhyloLevel pId lvl empty)) [1..lvlMax]
+initPhyloScales :: Int -> Period -> Map PhyloScaleId PhyloScale
+initPhyloScales lvlMax pId =
+    fromList $ map (\lvl -> ((pId,lvl),PhyloScale pId ("","") lvl empty)) [1..lvlMax]
+
 
 
---  To init the basic elements of a Phylo
-toPhyloBase :: [Document] -> TermList -> Config -> Phylo
-toPhyloBase docs lst conf = 
+--  Init the basic elements of a Phylo
+--
+initPhylo :: [Document] -> TermList -> PhyloConfig -> Phylo
+initPhylo docs lst conf =
     let foundations  = PhyloFoundations (Vector.fromList $ nub $ concat $ map text docs) lst
+        docsSources  = PhyloSources     (Vector.fromList $ nub $ concat $ map sources docs)
         params = defaultPhyloParam { _phyloParam_config = conf }
         periods = toPeriods (sort $ nub $ map date docs) (getTimePeriod $ timeUnit conf) (getTimeStep $ timeUnit conf)
-    in trace ("\n" <> "-- | Create PhyloBase out of " <> show(length docs) <> " docs \n") 
+    in trace ("\n" <> "-- | Init a phylo out of " <> show(length docs) <> " docs \n")
        $ Phylo foundations
+               docsSources
                (docsToTimeScaleCooc docs (foundations ^. foundations_roots))
                (docsToTimeScaleNb docs)
                (docsToTermFreq docs (foundations ^. foundations_roots))
-               empty
-               empty
+               (docsToLastTermFreq (getTimePeriod $ timeUnit conf) docs (foundations ^. foundations_roots))
+               Set.empty
                params
-               (fromList $ map (\prd -> (prd, PhyloPeriod prd (initPhyloLevels 1 prd))) periods)
+               (fromList $ map (\prd -> (prd, PhyloPeriod prd ("","") (initPhyloScales 1 prd))) periods)
+               0