add a json conf to Main.hs and fix issue between foundations, roots & termLists

bin/gargantext-phylo/Main.hs

@@ -30,6 +30,7 @@ import Gargantext.Prelude
 import Gargantext.Text.List.CSV (csvGraphTermList)
 import Gargantext.Text.Parsers.CSV (readCsv, csv_title, csv_abstract, csv_publication_year)
 import Gargantext.Text.Terms.WithList
+import Gargantext.Text.Context (TermList)
 
 import System.Environment
 
@@ -46,17 +47,33 @@ import qualified Data.Text   as DT
 import qualified Prelude     as P
 import qualified Data.ByteString.Lazy as L
 
-------------------------------------------------------------------------
--- Format to produce the Phylo
-data TextsByYear =
-  TextsByYear { year    :: Int
-              , texts   :: [[Text]]
-              } deriving (Show, Generic)
 
-instance ToJSON TextsByYear
+--------------
+-- | Conf | --
+--------------
+
+type ListPath   = FilePath
+type CorpusPath = FilePath
+type Limit = Int
+
+data Conf = 
+     Conf { corpusPath :: CorpusPath 
+          , listPath   :: ListPath
+          , outputPath :: FilePath
+          , limit      :: Limit
+     } deriving (Show,Generic)
+
+instance FromJSON Conf
+instance ToJSON Conf
+
+-- | Get the conf from a Json file
+getJson :: FilePath -> IO L.ByteString
+getJson path = L.readFile path
+
+---------------
+-- | Parse | --
+---------------
 
-instance ToJSON Document
-------------------------------------------------------------------------
 
 filterTerms :: Patterns -> (a, Text) -> (a, [Text])
 filterTerms patterns (year', doc) = (year',termsInText patterns doc)
@@ -71,53 +88,49 @@ csvToCorpus limit csv = DV.toList
                       . DV.map (\n -> (csv_publication_year n, (csv_title n) <> " " <> (csv_abstract n)))
                       . snd <$> readCsv csv
 
-type ListPath   = FilePath
-type CorpusPath = FilePath
-type Limit = Int
-
-parse :: Limit -> CorpusPath -> ListPath -> IO [Document]
-parse limit corpus liste = do
+parse :: Limit -> CorpusPath -> TermList -> IO [Document]
+parse limit corpus lst = do
   corpus' <- csvToCorpus limit corpus
-  liste'  <- csvGraphTermList  liste
-  let patterns = buildPatterns liste'
+  let patterns = buildPatterns lst
   pure $ map ( (\(y,t) -> Document y t) . filterTerms patterns) corpus'
 
 
+--------------
+-- | Main | --
+--------------
+
+
 main :: IO ()
-main = do
-  
-  
-  -- [corpusPath, termListPath, outputPath] <- getArgs
+main = do 
 
-  let corpusPath   = "/home/qlobbe/data/epique/corpus/cultural_evolution/texts/fullCorpus.csv"
-  let termListPath = "/home/qlobbe/data/epique/corpus/cultural_evolution/termList.csv"
-  let outputPath   = "/home/qlobbe/data/epique/output/cultural_evolution.dot"
+  putStrLn $ show "--| Read the conf |--"
 
-  let query     = PhyloQueryBuild "cultural_evolution" "" 5 3 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.00001 10) 
-                  2 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.5 10)
-  
-  let queryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
+  [jsonPath] <- getArgs
 
-  putStrLn $ show "-- Start parsing the corpus"
+  confJson <- (eitherDecode <$> getJson jsonPath) :: IO (P.Either P.String Conf)
 
-  corpus <- parse 2000 corpusPath termListPath 
+  case confJson of
+    P.Left err -> putStrLn err
+    P.Right conf -> do  
 
-  let foundations = DL.nub $ DL.concat $ map text corpus
+      putStrLn $ show "--| Parse the corpus |--"
 
-  -- putStrLn $ show (map text corpus)
+      termList <- csvGraphTermList (listPath conf)
 
-  -- foundations <- DL.concat <$> DL.concat <$> map snd <$> csvGraphTermList termListPath
+      corpus <- parse (limit conf) (corpusPath conf) termList
 
-  -- putStrLn $ show foundations
+      let roots = DL.nub $ DL.concat $ map text corpus
 
-  -- a <- map snd <$> csvGraphTermList liste
+      putStrLn $ show "--| Build the phylo |--" 
+      
+      let query = PhyloQueryBuild "cultural_evolution" "" 5 3 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.00001 10) 2 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.5 10)
 
-  let phylo = toPhylo query corpus foundations []
+      let queryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True           
 
-  let view  = toPhyloView queryView phylo
+      let phylo = toPhylo query corpus roots termList
 
-    -- TODO Phylo here
-  P.writeFile outputPath $ dotToString $ viewToDot view 
-  -- L.writeFile outputPath $ encode corpus
+      let view  = toPhyloView queryView phylo
 
+      putStrLn $ show "--| Export the phylo as a dot graph |--" 
 
+      P.writeFile (outputPath conf) $ dotToString $ viewToDot view       

src/Gargantext/Viz/Phylo.hs

@@ -41,6 +41,7 @@ import Data.Vector  (Vector)
 import GHC.Generics (Generic)
 --import Gargantext.Database.Schema.Ngrams (NgramsId)
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Text.Context (TermList)
 import Gargantext.Prelude
 
 --------------------
@@ -74,23 +75,18 @@ data Software =
 -- Periods     : list of all the periods of a Phylo
 data Phylo =
      Phylo { _phylo_duration    :: (Start, End)
-           , _phylo_foundations :: Vector Ngrams
-           , _phylo_foundationsRoots :: PhyloRoots
+           , _phylo_foundations :: PhyloFoundations
            , _phylo_periods     :: [PhyloPeriod]
            , _phylo_param       :: PhyloParam
            }
            deriving (Generic, Show, Eq)
 
--- | 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 PhyloRoots =
-      PhyloRoots { _phylo_rootsLabels :: Vector Ngrams
-                 , _phylo_rootsForest :: [Tree Ngrams]
-                 }
-                 deriving (Generic, Show, Eq)
 
--- | A Tree of Ngrams where each node is a label
-data Tree a = Empty | Node a [Tree a] deriving (Generic, Show, Eq)
+-- | The foundations of a phylomemy created from a given TermList 
+data PhyloFoundations =
+  PhyloFoundations { _phylo_foundationsRoots :: Vector Ngrams
+                   , _phylo_foundationsTermsList :: TermList
+  } deriving (Generic, Show, Eq)
 
 
 -- | Date : a simple Integer
@@ -443,7 +439,7 @@ makeLenses ''PhyloParam
 makeLenses ''Software
 --
 makeLenses ''Phylo
-makeLenses ''PhyloRoots
+makeLenses ''PhyloFoundations
 makeLenses ''PhyloGroup
 makeLenses ''PhyloLevel
 makeLenses ''PhyloPeriod
@@ -468,8 +464,7 @@ makeLenses ''PhyloEdge
 
 
 $(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
-$(deriveJSON (unPrefix "_phylo_roots"  ) ''PhyloRoots  )
-$(deriveJSON defaultOptions ''Tree  )
+$(deriveJSON (unPrefix "_phylo_foundations"  ) ''PhyloFoundations  )
 $(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
 $(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )
 $(deriveJSON (unPrefix "_phylo_group"  ) ''PhyloGroup  )

src/Gargantext/Viz/Phylo/API.hs

@@ -103,7 +103,7 @@ postPhylo _n _lId q = do
     vrs = Just ("1" :: Text)
     sft = Just (Software "Gargantext" "4")
     prm = initPhyloParam vrs sft (Just q)
-  pure (toPhyloBase q prm corpus actants actantsTrees)
+  pure (toPhyloBase q prm corpus actants termList)
 
 
 ------------------------------------------------------------------------
@@ -144,7 +144,7 @@ instance ToSchema PhyloGroup
 instance ToSchema PhyloLevel
 instance ToSchema PhyloNode
 instance ToSchema PhyloParam
-instance ToSchema PhyloRoots
+instance ToSchema PhyloFoundations
 instance ToSchema PhyloPeriod
 instance ToSchema PhyloQueryBuild
 instance ToSchema PhyloView
@@ -186,10 +186,6 @@ instance FromHttpApiData Sort
     parseUrlPiece = readTextData
 instance ToParamSchema Sort
 
-instance (ToSchema a) => ToSchema (Tree a)
-  where
-    declareNamedSchema = genericDeclareNamedSchemaUnrestricted
-                       $ swaggerOptions ""
 
 instance ToSchema Proximity
   where

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

@@ -17,17 +17,14 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.Aggregates.Document
   where
 
-import Control.Lens         hiding (both, Level)
-
-import Data.List        (last,nub,(++))
-import Data.Map         (Map,member)
+import Data.List        (last)
+import Data.Map         (Map)
 import Data.Text        (Text)
-import Data.Tuple       (fst, snd)
+import Data.Tuple       (fst)
 import Data.Vector      (Vector)
 import Gargantext.Prelude
-import Gargantext.Text.Terms.Mono               (monoTexts)
+import Gargantext.Text.Terms.Mono (monoTexts)
 import Gargantext.Viz.Phylo
-import Gargantext.Viz.Phylo.Tools
 import qualified Data.List   as List
 import qualified Data.Map    as Map
 import qualified Data.Vector as Vector
@@ -50,27 +47,11 @@ groupDocsByPeriod f pds es = Map.fromList $ zip pds $ map (inPeriode f es) pds
       fst $ List.partition (\d -> f' d >= start && f' d <= end) h
     --------------------------------------
 
--- | 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 -> 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
-    --------------------------------------
-    mRoots :: Map Ngrams Ngrams
-    mRoots = forestToMap (roots ^. phylo_rootsForest)
-    --------------------------------------
-
-
--- | To transform a Corpus of texts into a Map of aggregated Documents grouped by Periods
+parseDocs :: Vector Ngrams -> [(Date,Text)] -> [Document]
+parseDocs roots c = map (\(d,t)
+                -> Document d ( filter (\x -> Vector.elem x roots)
+                              $ monoTexts t)) c
 
 

src/Gargantext/Viz/Phylo/Example.hs

@@ -36,6 +36,7 @@ import Data.Tuple       (fst)
 import Data.Tuple.Extra
 import Data.Vector      (Vector)
 import Gargantext.Prelude
+import Gargantext.Text.Context (TermList)
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Aggregates.Cluster
 import Gargantext.Viz.Phylo.Aggregates.Document
@@ -85,7 +86,7 @@ phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch]
 
 
 phyloFromQuery :: Phylo
-phyloFromQuery = toPhylo (queryParser queryEx) corpus actants actantsTrees
+phyloFromQuery = toPhylo (queryParser queryEx) corpus actants termList
 
 -- | To do : create a request handler and a query parser
 queryParser :: [Char] -> PhyloQueryBuild
@@ -223,36 +224,27 @@ phyloDocs = corpusToDocs corpus phyloBase
 
 
 phyloBase :: Phylo
-phyloBase = initPhyloBase periods foundations roots defaultPhyloParam
-
+phyloBase = initPhyloBase periods (PhyloFoundations foundationsRoots termList) defaultPhyloParam
 
 periods :: [(Date,Date)]
 periods = initPeriods 5 3
         $ both fst (head' "Example" corpus,last corpus)
 
-
-roots :: PhyloRoots
-roots = initRoots (map (\t -> alterLabels phyloAnalyzer t) actantsTrees) foundations
-
-
-foundations :: Vector Ngrams
-foundations = initFoundations actants
+foundationsRoots :: Vector Ngrams
+foundationsRoots = initFoundationsRoots actants
 
 
 --------------------------------------------
 -- | STEP 0 | -- Let's start with an example
 --------------------------------------------
 
-actantsTrees :: [Tree Ngrams]
-actantsTrees = []
--- actantsTrees = [Node "Cite antique" [(Node "Rome" []),(Node "Alexandrie" [])]]
-
+termList :: TermList
+termList = []
 
 actants :: [Ngrams]
 actants = [ "Cleopatre"   , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV"
           , "Marc-Antoine", "Cesar"   , "Antoine"      , "Octave"  , "Rome"
           , "Alexandrie"  , "Auguste" , "Pompee"       , "Cassius" , "Brutus"]
 
-
 corpus :: [(Date, Text)]
 corpus = List.sortOn fst [ (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."), (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII.  Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]

src/Gargantext/Viz/Phylo/LevelMaker.hs

@@ -24,7 +24,6 @@ import Data.List                    ((++), sort, concat, nub, zip, last)
 import Data.Map                     (Map, (!), empty, restrictKeys, filterWithKey, singleton, union)
 import Data.Text (Text)
 import Data.Tuple.Extra
-import Data.Vector                  (Vector)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Aggregates.Cluster
@@ -34,6 +33,7 @@ import Gargantext.Viz.Phylo.Aggregates.Fis
 import Gargantext.Viz.Phylo.BranchMaker
 import Gargantext.Viz.Phylo.LinkMaker
 import Gargantext.Viz.Phylo.Tools
+import Gargantext.Text.Context (TermList)
 import qualified Data.Set    as Set
 
 
@@ -190,14 +190,14 @@ toPhylo0 d p = addPhyloLevel 0 d p
 
 class PhyloMaker corpus
     where
-        toPhylo ::  PhyloQueryBuild -> corpus -> [Ngrams] -> [Tree Ngrams] -> Phylo
-        toPhyloBase :: PhyloQueryBuild -> PhyloParam -> corpus -> [Ngrams] -> [Tree Ngrams] -> Phylo
+        toPhylo ::  PhyloQueryBuild -> corpus -> [Ngrams] -> TermList -> Phylo
+        toPhyloBase :: PhyloQueryBuild -> PhyloParam -> corpus -> [Ngrams] -> TermList -> Phylo
         corpusToDocs :: corpus -> Phylo -> Map (Date,Date) [Document]
 
 instance PhyloMaker [(Date, Text)]
   where
     --------------------------------------
-    toPhylo q c a ts = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthCluster q) phylo1
+    toPhylo q c roots termList = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthCluster q) phylo1
       where
         --------------------------------------
         phylo1 :: Phylo
@@ -210,30 +210,27 @@ instance PhyloMaker [(Date, Text)]
         phyloDocs = corpusToDocs c phyloBase
         --------------------------------------
         phyloBase :: Phylo
-        phyloBase = toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c a ts
+        phyloBase = toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c roots termList
         --------------------------------------       
     --------------------------------------
-    toPhyloBase q p c a ts = initPhyloBase periods foundations roots p
+    toPhyloBase q p c roots termList = initPhyloBase periods foundations p
       where
         --------------------------------------
-        roots :: PhyloRoots
-        roots = initRoots (map (\t -> alterLabels phyloAnalyzer t) ts) foundations
+        foundations :: PhyloFoundations
+        foundations = PhyloFoundations (initFoundationsRoots roots) termList
         --------------------------------------
         periods :: [(Date,Date)]
         periods = initPeriods (getPeriodGrain q) (getPeriodSteps q)
                 $ both fst (head' "LevelMaker" c,last c)
         --------------------------------------
-        foundations :: Vector Ngrams
-        foundations = initFoundations a
-        --------------------------------------
     --------------------------------------
-    corpusToDocs c p = groupDocsByPeriod date (getPhyloPeriods p) $ parseDocs (getFoundations p) (getRoots p) c
+    corpusToDocs c p = groupDocsByPeriod date (getPhyloPeriods p) $ parseDocs (getFoundationsRoots p) c
 
 
 instance PhyloMaker [Document]
   where
     --------------------------------------
-    toPhylo q c a ts = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthCluster q) phylo1
+    toPhylo q c roots termList = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthCluster q) phylo1
       where
         --------------------------------------
         phylo1 :: Phylo
@@ -246,21 +243,18 @@ instance PhyloMaker [Document]
         phyloDocs = corpusToDocs c phyloBase
         --------------------------------------
         phyloBase :: Phylo
-        phyloBase = toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c a ts
+        phyloBase = toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c roots termList
         --------------------------------------       
     --------------------------------------
-    toPhyloBase q p c a ts = initPhyloBase periods foundations roots p
+    toPhyloBase q p c roots termList = initPhyloBase periods foundations p
       where
         --------------------------------------
-        roots :: PhyloRoots
-        roots = initRoots (map (\t -> alterLabels phyloAnalyzer t) ts) foundations
+        foundations :: PhyloFoundations
+        foundations = PhyloFoundations (initFoundationsRoots roots) termList
         --------------------------------------
         periods :: [(Date,Date)]
         periods = initPeriods (getPeriodGrain q) (getPeriodSteps q)
                 $ both date (head' "LevelMaker" c,last c)
         --------------------------------------
-        foundations :: Vector Ngrams
-        foundations = initFoundations a
-        --------------------------------------
     --------------------------------------
     corpusToDocs c p = groupDocsByPeriod date (getPhyloPeriods p) c
\ No newline at end of file

src/Gargantext/Viz/Phylo/Tools.hs

@@ -20,7 +20,7 @@ module Gargantext.Viz.Phylo.Tools
   where
 
 import Control.Lens         hiding (both, Level, Empty)
-import Data.List            (filter, intersect, (++), sort, null, tail, last, tails, delete, nub, concat, sortOn, nubBy)
+import Data.List            (filter, intersect, (++), sort, null, tail, last, tails, delete, nub, sortOn, nubBy)
 import Data.Maybe           (mapMaybe,fromMaybe)
 import Data.Map             (Map, mapKeys, member, (!))
 import Data.Set             (Set)
@@ -150,29 +150,18 @@ unifySharedKeys m1 m2 = mapKeys (\(x,y) -> if member (y,x) m2
 phyloAnalyzer :: Ngrams -> Ngrams
 phyloAnalyzer n = toLower n
 
--- | To init the foundation of the Phylo as a Vector of Ngrams
-initFoundations :: [Ngrams] -> Vector Ngrams
-initFoundations l = Vector.fromList $ map phyloAnalyzer l
+-- | To init the foundation roots of the Phylo as a Vector of Ngrams
+initFoundationsRoots :: [Ngrams] -> Vector Ngrams
+initFoundationsRoots 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 -> PhyloRoots -> PhyloParam -> Phylo
-initPhyloBase pds fds pks prm = Phylo ((fst . (head' "initPhyloBase")) pds, (snd . last) pds) fds pks (map (\pd -> initPhyloPeriod pd []) pds) prm
+initPhyloBase :: [(Date, Date)] -> PhyloFoundations -> PhyloParam -> Phylo
+initPhyloBase pds fds prm = Phylo ((fst . (head' "initPhyloBase")) pds, (snd . last) pds) fds (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 defaultQueryBuild -> q) = PhyloParam v s q
 
--- | To get the foundations of a Phylo
-getFoundations :: Phylo -> Vector Ngrams
-getFoundations = _phylo_foundations
-
--- | To get the Index of a Ngrams in the Foundations of a Phylo
-getIdxInFoundations :: Ngrams -> Phylo -> Int
-getIdxInFoundations n p = case (elemIndex n (getFoundations p)) of
-    Nothing  -> panic "[ERR][Viz.Phylo.Tools.getIdxInFoundations] Ngrams not in Foundations"
-    Just idx -> idx
-
-
 -- | To get the last computed Level in a Phylo
 getLastLevel :: Phylo -> Level
 getLastLevel p = (last . sort)
@@ -186,54 +175,20 @@ getLastLevel p = (last . sort)
 -- | PhyloRoots | --
 --------------------
 
--- | To apply a fonction to each label of a Ngrams Tree
-alterLabels :: (Ngrams -> Ngrams) -> Tree Ngrams -> Tree Ngrams
-alterLabels f (Node lbl ns) = Node (f lbl) (map (\n -> alterLabels f n) ns)
-alterLabels _ Empty         = panic "[ERR][Viz.Phylo.Tools.alterLabels] Empty"
-
--- | To transform a forest of trees into a map (node,root)
-forestToMap :: [Tree Ngrams] -> Map Ngrams Ngrams
-forestToMap trees = Map.fromList $ concat $ map treeToTuples' trees
-  where
-    treeToTuples' (Node lbl ns) = treeToTuples (Node lbl ns) lbl
-    treeToTuples' Empty         = panic "[ERR][Viz.Phylo.Tools.forestToMap] Empty"
-
--- | To get the foundationsRoots of a Phylo
-getRoots :: Phylo -> PhyloRoots
-getRoots = _phylo_foundationsRoots
+-- | To get the foundations of a Phylo
+getFoundations :: Phylo -> PhyloFoundations
+getFoundations = _phylo_foundations
 
--- | To get the RootsLabels of a Phylo
-getRootsLabels :: Phylo -> Vector Ngrams
-getRootsLabels p = (getRoots p) ^. phylo_rootsLabels
+-- | To get the foundations roots of a Phylo
+getFoundationsRoots :: Phylo -> Vector Ngrams
+getFoundationsRoots p = (getFoundations p) ^. phylo_foundationsRoots
 
 -- | 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
+getIdxInRoots n p = case (elemIndex n (getFoundationsRoots p)) of
     Nothing  -> panic "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots"
     Just idx -> idx
 
--- | To init the PhyloRoots of a Phylo
-initRoots :: [Tree Ngrams] -> Vector Ngrams -> PhyloRoots
-initRoots trees ns = PhyloRoots labels trees
-  where
-    --------------------------------------
-    labels :: Vector Ngrams
-    labels = Vector.fromList
-           $ nub
-           $ Vector.toList
-           $ map (\n -> if member n mTrees
-                        then mTrees Map.! n
-                        else n ) ns
-    --------------------------------------
-    mTrees :: Map Ngrams Ngrams
-    mTrees = forestToMap trees
-    --------------------------------------
-
--- | To transform a Ngrams Tree into a list of (node,root)
-treeToTuples :: Tree Ngrams -> Ngrams -> [(Ngrams,Ngrams)]
-treeToTuples (Node lbl ns) root = [(lbl,root)] ++ (concat $ map (\n -> treeToTuples n root) ns)
-treeToTuples Empty         _    = panic "[ERR][Viz.Phylo.Tools.treeToTuples] Empty"
-
 --------------------
 -- | PhyloGroup | --
 --------------------
@@ -353,7 +308,7 @@ getGroupPeriodParentsId g = map fst $ getGroupPeriodParents g
 
 -- | To get the roots labels of a list of group ngrams
 getGroupText :: PhyloGroup -> Phylo -> [Text] 
-getGroupText g p = ngramsToText (getRootsLabels p) (getGroupNgrams g) 
+getGroupText g p = ngramsToText (getFoundationsRoots p) (getGroupNgrams g) 
 
 
 -- | To get all the PhyloGroup of a Phylo

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

@@ -65,7 +65,7 @@ alterBranchPeak (id,lbl) v = over (pv_branches
 -- | 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)
+                        $ map (\(id,ns) -> (id, freqToLabel thr (getFoundationsRoots p)
                                               $ getGroupsFromNodes ns p))
                         $ getNodesByBranches v
 
@@ -74,7 +74,7 @@ branchPeakFreq v thr p = foldl (\v' (id,lbl) -> alterBranchPeak (id,lbl) v') v
 nodeLabelCooc :: PhyloView -> Int -> Phylo -> PhyloView
 nodeLabelCooc v thr p = over (pv_nodes
                              . traverse)
-                             (\n -> let lbl = ngramsToLabel (getRootsLabels p)
+                             (\n -> let lbl = ngramsToLabel (getFoundationsRoots p)
                                             $ mostOccNgrams thr
                                             $ head' "nodeLabelCooc" $ getGroupsFromIds [getNodeId n] p
                                     in n & pn_label .~ lbl) v

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

@@ -49,7 +49,7 @@ initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl
                                     (getPhyloPeriods p)
                                     empty
                                     ([] ++ (phyloToBranches lvl p))
-                                    ([] ++ (groupsToNodes True vb (getRootsLabels p) gs))
+                                    ([] ++ (groupsToNodes True vb (getFoundationsRoots p) gs))
                                     ([] ++ (groupsToEdges fl PeriodEdge gs))
   where
     --------------------------------------
@@ -123,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 (getRootsLabels p) gs'))
+         & pv_nodes %~ (++ (groupsToNodes False vb (getFoundationsRoots p) gs'))
          & pv_edges %~ (++ (groupsToEdges fl PeriodEdge gs'))
          & pv_edges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
          & pv_edges %~ (++ (groupsToEdges Ascendant LevelEdge  gs'))