fix some bugs

src/Gargantext/Viz/Phylo.hs

@@ -74,17 +74,17 @@ data Software =
 data Phylo =
      Phylo { _phylo_duration    :: (Start, End)
            , _phylo_foundations :: Vector Ngrams
-           , _phylo_foundationsPeaks :: PhyloPeaks
+           , _phylo_foundationsRoots :: PhyloRoots
            , _phylo_periods     :: [PhyloPeriod]
            , _phylo_param       :: PhyloParam
            }
            deriving (Generic, Show, Eq)
 
--- | The PhyloPeaks describe the aggregation of some foundations Ngrams behind a list of Ngrams trees (ie: a forest)
+-- | The PhyloRoots describe the aggregation of some foundations Ngrams behind a list of Ngrams trees (ie: a forest)
 -- PeaksLabels are the root labels of each Ngrams trees
-data PhyloPeaks =
-      PhyloPeaks { _phylo_peaksLabels :: Vector Ngrams
-                 , _phylo_peaksForest :: [Tree Ngrams]
+data PhyloRoots =
+      PhyloRoots { _phylo_rootsLabels :: Vector Ngrams
+                 , _phylo_rootsForest :: [Tree Ngrams]
                  }
                  deriving (Generic, Show, Eq)
 
@@ -306,7 +306,7 @@ data Metric = BranchAge deriving (Generic, Show, Eq)
 
 
 -- | Tagger constructors
-data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
+data Tagger = BranchPeakFreq | GroupLabelCooc | GroupDynamics deriving (Show)
 
 
 --------------
@@ -363,6 +363,7 @@ data PhyloView = PhyloView
   , _pv_description :: Text
   , _pv_filiation   :: Filiation
   , _pv_level       :: Level
+  , _pv_periods     :: [PhyloPeriodId]
   , _pv_metrics     :: Map Text [Double]
   , _pv_branches    :: [PhyloBranch]
   , _pv_nodes       :: [PhyloNode]
@@ -372,7 +373,7 @@ data PhyloView = PhyloView
 -- | A phyloview is made of PhyloBranches, edges and nodes
 data PhyloBranch = PhyloBranch
   { _pb_id      :: PhyloBranchId
-  , _pb_label   :: Text
+  , _pb_peak    :: Text
   , _pb_metrics :: Map Text [Double]
   } deriving (Generic, Show)
 
@@ -438,7 +439,7 @@ makeLenses ''PhyloParam
 makeLenses ''Software
 --
 makeLenses ''Phylo
-makeLenses ''PhyloPeaks
+makeLenses ''PhyloRoots
 makeLenses ''PhyloGroup
 makeLenses ''PhyloLevel
 makeLenses ''PhyloPeriod
@@ -463,7 +464,7 @@ makeLenses ''PhyloEdge
 
 
 $(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
-$(deriveJSON (unPrefix "_phylo_peaks"  ) ''PhyloPeaks  )
+$(deriveJSON (unPrefix "_phylo_roots"  ) ''PhyloRoots  )
 $(deriveJSON defaultOptions ''Tree  )
 $(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
 $(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )

src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs

@@ -31,7 +31,7 @@ fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
 fisToCooc m p = map   (/docs)
               $ foldl (\mem x -> adjust (+1) (getKeyPair x mem) mem) cooc
               $ concat
-              $ map (\x -> listToUnDirectedCombiWith (\y -> getIdxInPeaks y p) $ (Set.toList . getClique) x)
+              $ map (\x -> listToUnDirectedCombiWith (\y -> getIdxInRoots y p) $ (Set.toList . getClique) x)
               $ (concat . elems) m
   where
     --------------------------------------
@@ -42,7 +42,7 @@ fisToCooc m p = map   (/docs)
     docs = fromIntegral $ foldl (\mem x -> mem + (getSupport x)) 0 $ (concat . elems) m
     --------------------------------------
     cooc :: Map (Int, Int) (Double)
-    cooc = Map.fromList $ map (\x -> (x,0)) (listToUnDirectedCombiWith (\y -> getIdxInPeaks y p) fisNgrams)
+    cooc = Map.fromList $ map (\x -> (x,0)) (listToUnDirectedCombiWith (\y -> getIdxInRoots y p) fisNgrams)
     --------------------------------------
 
 

src/Gargantext/Viz/Phylo/Aggregates/Document.hs

@@ -50,27 +50,28 @@ groupDocsByPeriod f pds es = Map.fromList $ zip pds $ map (inPeriode f es) pds
       fst $ List.partition (\d -> f' d >= start && f' d <= end) h
     --------------------------------------
 
-reduceByPeaks :: Map Ngrams Ngrams -> [Ngrams] -> [Ngrams]
-reduceByPeaks m ns = (\(f,s) -> f ++ (nub s))
+-- | Reduce a list of foundations as a list of corresponding roots 
+reduceByRoots :: Map Ngrams Ngrams -> [Ngrams] -> [Ngrams]
+reduceByRoots m ns = (\(f,s) -> f ++ (nub s))
                     $ foldl (\mem n -> if member n m
                                       then (fst mem,(snd mem) ++ [m Map.! n])
                                       else ((fst mem) ++ [n],snd mem)
                                       ) ([],[]) ns
 
 -- | To parse a list of Documents by filtering on a Vector of Ngrams
-parseDocs :: Vector Ngrams -> PhyloPeaks -> [(Date,Text)] -> [Document]
-parseDocs fds peaks c = map (\(d,t)
-                         -> Document d ( reduceByPeaks mPeaks
+parseDocs :: Vector Ngrams -> PhyloRoots -> [(Date,Text)] -> [Document]
+parseDocs fds roots c = map (\(d,t)
+                         -> Document d ( reduceByRoots mRoots
                                        $ filter (\x -> Vector.elem x fds)
                                        $ monoTexts t)) c
   where
     --------------------------------------
-    mPeaks :: Map Ngrams Ngrams
-    mPeaks = forestToMap (peaks ^. phylo_peaksForest)
+    mRoots :: Map Ngrams Ngrams
+    mRoots = forestToMap (roots ^. phylo_rootsForest)
     --------------------------------------
 
 
 -- | To transform a Corpus of texts into a Map of aggregated Documents grouped by Periods
 corpusToDocs :: [(Date,Text)] -> Phylo -> Map (Date,Date) [Document]
 corpusToDocs c p = groupDocsByPeriod date (getPhyloPeriods p)
-                $ parseDocs (getFoundations p) (getPeaks p) c
+                $ parseDocs (getFoundations p) (getRoots p) c

src/Gargantext/Viz/Phylo/Example.hs

@@ -53,6 +53,8 @@ import qualified Data.List   as List
 -- | STEP 12 | -- Create a PhyloView from a user Query
 ------------------------------------------------------
 
+export :: IO ()
+export = dotToFile "./export_test" "cesar_cleopatre.dot" phyloDot 
 
 phyloDot :: DotGraph DotId
 phyloDot = viewToDot phyloView
@@ -69,12 +71,12 @@ queryViewEx = "level=3"
               ++ "&childs=false"
               ++ "&filter=LonelyBranchFilter"
               ++ "&metric=BranchAge"
-              ++ "&tagger=BranchLabelFreq"
+              ++ "&tagger=BranchPeakFreq"
               ++ "&tagger=GroupLabelCooc"
 
 
 phyloQueryView :: PhyloQueryView
-phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
+phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
 
 
 --------------------------------------------------
@@ -87,7 +89,7 @@ phyloFromQuery = toPhylo (queryParser queryEx) corpus actants actantsTrees
 
 -- | To do : create a request handler and a query parser
 queryParser :: [Char] -> PhyloQueryBuild
-queryParser _q = phyloQuery
+queryParser _q = phyloQueryBuild
 
 queryEx :: [Char]
 queryEx = "title=Cesar et Cleôpatre"
@@ -99,8 +101,8 @@ queryEx = "title=Cesar et Cleôpatre"
           ++ "nthCluster=RelatedComponents"
           ++ "nthProximity=Filiation"
 
-phyloQuery :: PhyloQueryBuild
-phyloQuery = PhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
+phyloQueryBuild :: PhyloQueryBuild
+phyloQueryBuild = PhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
              5 3 defaultFis [] [] defaultWeightedLogJaccard 3 defaultRelatedComponents
 
 
@@ -199,7 +201,7 @@ phylo1 =  addPhyloLevel (1) phyloFis phylo
 
 
 phyloFis :: Map (Date, Date) [PhyloFis]
-phyloFis = filterFisByNested $ filterFisBySupport False 1 (docsToFis phyloDocs)
+phyloFis = filterFisByNested $ filterFisBySupport True 1 (docsToFis phyloDocs)
 
 
 ----------------------------------------
@@ -221,7 +223,7 @@ phyloDocs = corpusToDocs corpus phyloBase
 
 
 phyloBase :: Phylo
-phyloBase = initPhyloBase periods foundations peaks defaultPhyloParam
+phyloBase = initPhyloBase periods foundations roots defaultPhyloParam
 
 
 periods :: [(Date,Date)]
@@ -229,8 +231,8 @@ periods = initPeriods 5 3
         $ both fst (head' "Example" corpus,last corpus)
 
 
-peaks :: PhyloPeaks
-peaks = initPeaks (map (\t -> alterLabels phyloAnalyzer t) actantsTrees) foundations
+roots :: PhyloRoots
+roots = initRoots (map (\t -> alterLabels phyloAnalyzer t) actantsTrees) foundations
 
 
 foundations :: Vector Ngrams
@@ -242,7 +244,8 @@ foundations = initFoundations actants
 --------------------------------------------
 
 actantsTrees :: [Tree Ngrams]
-actantsTrees = [Node "Cite antique" [(Node "Rome" []),(Node "Alexandrie" [])]]
+actantsTrees = []
+-- actantsTrees = [Node "Cite antique" [(Node "Rome" []),(Node "Alexandrie" [])]]
 
 
 actants :: [Ngrams]

src/Gargantext/Viz/Phylo/LevelMaker.hs

@@ -112,7 +112,7 @@ cliqueToGroup prd lvl idx lbl fis m p =
       where
         --------------------------------------
         ngrams :: [Int]
-        ngrams = sort $ map (\x -> getIdxInPeaks x p)
+        ngrams = sort $ map (\x -> getIdxInRoots x p)
                       $ Set.toList
                       $ getClique fis
         --------------------------------------
@@ -125,7 +125,7 @@ cliqueToGroup prd lvl idx lbl fis m p =
 -- | To transform a list of Ngrams into a PhyloGroup
 ngramsToGroup ::  PhyloPeriodId -> Level -> Int -> Text -> [Ngrams] -> Phylo -> PhyloGroup
 ngramsToGroup prd lvl idx lbl ngrams p =
-    PhyloGroup ((prd, lvl), idx) lbl (sort $ map (\x -> getIdxInPeaks x p) ngrams) empty empty Nothing [] [] [] []
+    PhyloGroup ((prd, lvl), idx) lbl (sort $ map (\x -> getIdxInRoots x p) ngrams) empty empty Nothing [] [] [] []
 
 
 -- | To traverse a Phylo and add a new PhyloLevel linked to a new list of PhyloGroups
@@ -182,11 +182,11 @@ toPhylo0 d p = addPhyloLevel 0 d p
 
 -- | To reconstruct the Base of a Phylo
 toPhyloBase :: PhyloQueryBuild -> PhyloParam -> [(Date, Text)] -> [Ngrams] -> [Tree Ngrams] -> Phylo
-toPhyloBase q p c a ts = initPhyloBase periods foundations peaks p
+toPhyloBase q p c a ts = initPhyloBase periods foundations roots p
   where
     --------------------------------------
-    peaks :: PhyloPeaks
-    peaks = initPeaks (map (\t -> alterLabels phyloAnalyzer t) ts) foundations
+    roots :: PhyloRoots
+    roots = initRoots (map (\t -> alterLabels phyloAnalyzer t) ts) foundations
     --------------------------------------
     periods :: [(Date,Date)]
     periods = initPeriods (getPeriodGrain q) (getPeriodSteps q)

src/Gargantext/Viz/Phylo/LinkMaker.hs

@@ -90,8 +90,8 @@ applyProximity prox g1 g2 = case prox of
 -- | To get the next or previous PhyloPeriod based on a given PhyloPeriodId
 getNextPeriods :: Filiation -> PhyloPeriodId -> [PhyloPeriodId] -> [PhyloPeriodId]
 getNextPeriods to' id l = case to' of
-    Descendant -> unNested id ((tail . snd) next)
-    Ascendant  -> unNested id ((reverse . fst) next)
+    Descendant -> (tail . snd) next
+    Ascendant  -> (reverse . fst) next
     _          -> panic ("[ERR][Viz.Phylo.Example.getNextPeriods] Filiation type not defined")
     where
       --------------------------------------
@@ -103,17 +103,6 @@ getNextPeriods to' id l = case to' of
         Nothing -> panic ("[ERR][Viz.Phylo.Example.getNextPeriods] PhyloPeriodId not defined")
         Just i  -> i
       --------------------------------------
-      -- | To have an non-overlapping next period
-      unNested :: PhyloPeriodId -> [PhyloPeriodId] -> [PhyloPeriodId]
-      unNested x l'
-        | null l'                  = []
-        | nested (fst $ head' "getNextPeriods1" l') x = unNested x (tail l')
-        | nested (snd $ head' "getNextPeriods2" l') x = unNested x (tail l')
-        | otherwise                = l
-      --------------------------------------
-      nested :: Date -> PhyloPeriodId -> Bool
-      nested d prd = d >= fst prd && d <= snd prd
-      --------------------------------------
 
 
 -- | To find the best set (max = 2) of Childs/Parents candidates based on a given Proximity mesure until a maximum depth (max = Period + 5 units )

src/Gargantext/Viz/Phylo/Tools.hs

@@ -146,12 +146,12 @@ initFoundations :: [Ngrams] -> Vector Ngrams
 initFoundations l = Vector.fromList $ map phyloAnalyzer l
 
 -- | To init the base of a Phylo from a List of Periods and Foundations
-initPhyloBase :: [(Date, Date)] -> Vector Ngrams -> PhyloPeaks -> PhyloParam -> Phylo
+initPhyloBase :: [(Date, Date)] -> Vector Ngrams -> PhyloRoots -> PhyloParam -> Phylo
 initPhyloBase pds fds pks prm = Phylo ((fst . (head' "initPhyloBase")) pds, (snd . last) pds) fds pks (map (\pd -> initPhyloPeriod pd []) pds) prm
 
 -- | To init the param of a Phylo
 initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQueryBuild -> PhyloParam
-initPhyloParam (def defaultPhyloVersion -> v) (def defaultSoftware -> s) (def defaultQuery -> q) = PhyloParam v s q
+initPhyloParam (def defaultPhyloVersion -> v) (def defaultSoftware -> s) (def defaultQueryBuild -> q) = PhyloParam v s q
 
 -- | To get the foundations of a Phylo
 getFoundations :: Phylo -> Vector Ngrams
@@ -174,7 +174,7 @@ getLastLevel p = (last . sort)
 
 
 --------------------
--- | PhyloPeaks | --
+-- | PhyloRoots | --
 --------------------
 
 -- | To apply a fonction to each label of a Ngrams Tree
@@ -189,23 +189,23 @@ forestToMap trees = Map.fromList $ concat $ map treeToTuples' trees
     treeToTuples' (Node lbl ns) = treeToTuples (Node lbl ns) lbl
     treeToTuples' Empty         = panic "[ERR][Viz.Phylo.Tools.forestToMap] Empty"
 
--- | To get the foundationsPeaks of a Phylo
-getPeaks :: Phylo -> PhyloPeaks
-getPeaks = _phylo_foundationsPeaks
+-- | To get the foundationsRoots of a Phylo
+getRoots :: Phylo -> PhyloRoots
+getRoots = _phylo_foundationsRoots
 
--- | To get the peaksLabels of a Phylo
-getPeaksLabels :: Phylo -> Vector Ngrams
-getPeaksLabels p = (getPeaks p) ^. phylo_peaksLabels
+-- | To get the RootsLabels of a Phylo
+getRootsLabels :: Phylo -> Vector Ngrams
+getRootsLabels p = (getRoots p) ^. phylo_rootsLabels
 
--- | To get the Index of a Ngrams in the foundationsPeaks of a Phylo
-getIdxInPeaks :: Ngrams -> Phylo -> Int
-getIdxInPeaks n p = case (elemIndex n (getPeaksLabels p)) of
-    Nothing  -> panic "[ERR][Viz.Phylo.Tools.getIdxInPeaks] Ngrams not in foundationsPeaks"
+-- | To get the Index of a Ngrams in the foundationsRoots of a Phylo
+getIdxInRoots :: Ngrams -> Phylo -> Int
+getIdxInRoots n p = case (elemIndex n (getRootsLabels p)) of
+    Nothing  -> panic "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots"
     Just idx -> idx
 
--- | To init the PhyloPeaks of a Phylo
-initPeaks :: [Tree Ngrams] -> Vector Ngrams -> PhyloPeaks
-initPeaks trees ns = PhyloPeaks labels trees
+-- | To init the PhyloRoots of a Phylo
+initRoots :: [Tree Ngrams] -> Vector Ngrams -> PhyloRoots
+initRoots trees ns = PhyloRoots labels trees
   where
     --------------------------------------
     labels :: Vector Ngrams
@@ -385,7 +385,7 @@ initGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> Phylo -> PhyloGroup
 initGroup ngrams lbl idx lvl from' to' p = PhyloGroup
   (((from', to'), lvl), idx)
   lbl
-  (sort $ map (\x -> getIdxInPeaks x p) ngrams)
+  (sort $ map (\x -> getIdxInRoots x p) ngrams)
   (Map.empty)
   (Map.empty)
   Nothing
@@ -708,9 +708,9 @@ initWeightedLogJaccard :: Maybe Double -> Maybe Double -> WLJParams
 initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
 
 
--- | To initialize a PhyloQuery from given and default parameters
-initPhyloQuery :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
-initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
+-- | To initialize a PhyloQueryBuild from given and default parameters
+initPhyloQueryBuild :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
+initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
   (def defaultWeightedLogJaccard -> matching') (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
     PhyloQueryBuild name desc grain steps cluster metrics filters matching' nthLevel nthCluster
 
@@ -760,8 +760,8 @@ defaultWeightedLogJaccard = WeightedLogJaccard (initWeightedLogJaccard Nothing N
 
 -- Queries
 
-defaultQuery :: PhyloQueryBuild
-defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
+defaultQueryBuild :: PhyloQueryBuild
+defaultQueryBuild = initPhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
                               Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 defaultQueryView :: PhyloQueryView

src/Gargantext/Viz/Phylo/View/Export.hs

@@ -26,18 +26,31 @@ import Data.GraphViz.Types.Monadic
 import Data.List        ((++),unwords,concat,sortOn,nub)
 import Data.Map         (Map,toList)
 import Data.Maybe       (isNothing,fromJust)
-import Data.Text.Lazy   (fromStrict, pack)
+import Data.Text.Lazy   (fromStrict, pack, unpack)
 
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as T'
 import qualified Data.GraphViz.Attributes.HTML as H
 
 import Gargantext.Prelude
-import Gargantext.Viz.Phylo
+import Gargantext.Viz.Phylo hiding (Dot)
 import Gargantext.Viz.Phylo.Tools
 
+
+import Prelude (writeFile)
+import System.FilePath
+
 type DotId = T'.Text
 
+
+---------------------
+-- | Dot to File | --
+---------------------
+
+dotToFile :: FilePath -> FilePath -> DotGraph DotId -> IO ()
+dotToFile filePath fileName dotG = writeFile (combine filePath fileName) $ unpack (printDotGraph dotG)
+
+
 --------------------------
 -- | PhyloView to DOT | --
 --------------------------
@@ -105,7 +118,7 @@ toDotLabel lbl = StrLabel $ fromStrict lbl
 -- | To set a Peak Node
 setPeakDotNode :: PhyloBranch -> Dot DotId
 setPeakDotNode pb = node (toBranchDotId $ pb ^. pb_id) 
-                      ([FillColor [toWColor CornSilk], FontName "Arial", FontSize 40, Shape Egg, Style [SItem Bold []], Label (toDotLabel $ pb ^. pb_label)]
+                      ([FillColor [toWColor CornSilk], FontName "Arial", FontSize 40, Shape Egg, Style [SItem Bold []], Label (toDotLabel $ pb ^. pb_peak)]
                        <> (setAttrFromMetrics $ pb ^. pb_metrics))
 
 
@@ -187,7 +200,7 @@ viewToDot pv = digraph ((Str . fromStrict) $ pv ^. pv_title)
 
                             mapM setDotNode $ filterNodesByPeriod prd $ filterNodesByLevel (pv ^. pv_level) (pv ^.pv_nodes)
                           
-                     ) $ getViewPeriods pv
+                     ) $ (pv ^. pv_periods)
 
                 -- set the edges : from peaks to nodes, from nodes to nodes, from periods to periods 
 
@@ -195,7 +208,7 @@ viewToDot pv = digraph ((Str . fromStrict) $ pv ^. pv_title)
 
                 _ <- mapM setDotEdge $ filterEdgesByLevel (pv ^. pv_level) $ filterEdgesByType PeriodEdge (pv ^. pv_edges)
 
-                mapM setDotPeriodEdge $ listToSequentialCombi $ getViewPeriods pv
+                mapM setDotPeriodEdge $ listToSequentialCombi $ (pv ^. pv_periods)
 
 
 

src/Gargantext/Viz/Phylo/View/Taggers.hs

@@ -64,19 +64,19 @@ mostOccNgrams thr group = (nub . concat )
                         $ reverse $ sortOn snd $ Map.toList $ getGroupCooc group
 
 
--- | To alter the label of a PhyloBranch
-alterBranchLabel :: (PhyloBranchId,Text) -> PhyloView -> PhyloView
-alterBranchLabel (id,lbl) v = over (pv_branches
+-- | To alter the peak of a PhyloBranch
+alterBranchPeak :: (PhyloBranchId,Text) -> PhyloView -> PhyloView
+alterBranchPeak (id,lbl) v = over (pv_branches
                                    . traverse)
                                    (\b -> if getBranchId b == id
-                                          then b & pb_label .~ lbl
+                                          then b & pb_peak .~ lbl
                                           else b) v
 
 
--- | To set the label of a PhyloBranch as the nth most frequent terms of its PhyloNodes
-branchLabelFreq :: PhyloView -> Int -> Phylo -> PhyloView
-branchLabelFreq v thr p = foldl (\v' (id,lbl) -> alterBranchLabel (id,lbl) v') v
-                        $ map (\(id,ns) -> (id, freqToLabel thr (getPeaksLabels p)
+-- | To set the peak of a PhyloBranch as the nth most frequent terms of its PhyloNodes
+branchPeakFreq :: PhyloView -> Int -> Phylo -> PhyloView
+branchPeakFreq v thr p = foldl (\v' (id,lbl) -> alterBranchPeak (id,lbl) v') v
+                        $ map (\(id,ns) -> (id, freqToLabel thr (getRootsLabels p)
                                               $ getGroupsFromNodes ns p))
                         $ getNodesByBranches v
 
@@ -85,7 +85,7 @@ branchLabelFreq v thr p = foldl (\v' (id,lbl) -> alterBranchLabel (id,lbl) v') v
 nodeLabelCooc :: PhyloView -> Int -> Phylo -> PhyloView
 nodeLabelCooc v thr p = over (pv_nodes
                              . traverse)
-                             (\n -> let lbl = ngramsToLabel (getPeaksLabels p)
+                             (\n -> let lbl = ngramsToLabel (getRootsLabels p)
                                             $ mostOccNgrams thr
                                             $ head' "nodeLabelCooc" $ getGroupsFromIds [getNodeId n] p
                                     in n & pn_label .~ lbl) v
@@ -94,7 +94,7 @@ nodeLabelCooc v thr p = over (pv_nodes
 -- | To process a sorted list of Taggers to a PhyloView
 processTaggers :: [Tagger] -> Phylo -> PhyloView -> PhyloView
 processTaggers ts p v = foldl (\v' t -> case t of
-                                        BranchLabelFreq -> branchLabelFreq v' 2 p
-                                        GroupLabelCooc  -> nodeLabelCooc   v' 2 p
-                                        _               -> panic "[ERR][Viz.Phylo.View.Taggers.processTaggers] tagger not found") v ts
+                                        BranchPeakFreq -> branchPeakFreq v' 2 p
+                                        GroupLabelCooc -> nodeLabelCooc  v' 2 p
+                                        _              -> panic "[ERR][Viz.Phylo.View.Taggers.processTaggers] tagger not found") v ts
 

src/Gargantext/Viz/Phylo/View/ViewMaker.hs

@@ -45,9 +45,11 @@ initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
 
 -- | To init a PhyloView
 initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView
-initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl empty
+initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl 
+                                    (getPhyloPeriods p)
+                                    empty
                                     ([] ++ (phyloToBranches lvl p))
-                                    ([] ++ (groupsToNodes True vb (getPeaksLabels p) gs))
+                                    ([] ++ (groupsToNodes True vb (getRootsLabels p) gs))
                                     ([] ++ (groupsToEdges fl PeriodEdge gs))
   where
     --------------------------------------
@@ -74,6 +76,7 @@ groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
                                   ) gs
 
 
+-- | To merge edges by keeping the maximum weight
 mergeEdges :: [PhyloEdge] -> [PhyloEdge] -> [PhyloEdge]
 mergeEdges lAsc lDes = elems
                      $ unionWithKey (\_k vAsc vDes -> vDes & pe_weight .~ (max (vAsc ^. pe_weight) (vDes ^. pe_weight))) mAsc mDes
@@ -81,6 +84,8 @@ mergeEdges lAsc lDes = elems
     --------------------------------------
     mAsc :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
     mAsc = fromList
+         $ map (\(k,e) -> (k, e & pe_source .~ fst k
+                                & pe_target .~ snd k))
          $ zip (map (\e -> (e ^. pe_target,e ^. pe_source)) lAsc) lAsc
     --------------------------------------
     mDes :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
@@ -118,7 +123,7 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
   then v
   else addChildNodes shouldDo (lvl - 1) lvlMin vb fl p
      $ v & pv_branches %~ (++ (phyloToBranches (lvl - 1) p))
-         & pv_nodes %~ (++ (groupsToNodes False vb (getPeaksLabels p) gs'))
+         & pv_nodes %~ (++ (groupsToNodes False vb (getRootsLabels p) gs'))
          & pv_edges %~ (++ (groupsToEdges fl PeriodEdge gs'))
          & pv_edges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
          & pv_edges %~ (++ (groupsToEdges Ascendant LevelEdge  gs'))