[Community] Query search contact with text query on documents
[gargantext.git] / src / Gargantext / Viz / Phylo / Tools.hs
index 0d70d3d70619d21f2c0ce40842e20a3858ddb266..e8993a0d5c28da5edeb46e4eba04fd5743ad1c8f 100644 (file)
@@ -10,26 +10,21 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module Gargantext.Viz.Phylo.Tools
   where
 
-import Control.Lens         hiding (both, Level)
-import Data.List            (filter, intersect, (++), sort, null, head, tail, last, tails, delete, nub, concat, union, sortOn)
+import Control.Lens         hiding (both, Level, Empty)
+import Data.List            (filter, intersect, (++), sort, null, tail, last, tails, delete, nub, sortOn, nubBy, concat)
 import Data.Maybe           (mapMaybe,fromMaybe)
-import Data.Map             (Map, mapKeys, member, elems, adjust, (!))
+import Data.Map             (Map, mapKeys, member, (!), restrictKeys, elems, empty, filterWithKey, unionWith)
 import Data.Set             (Set)
-import Data.Text            (Text, toLower)
+import Data.Text            (Text,toLower,unwords)
 import Data.Tuple.Extra
 import Data.Vector          (Vector,elemIndex)
-import Gargantext.Prelude   hiding (head)
+import Gargantext.Prelude
 import Gargantext.Viz.Phylo
-
-import qualified Data.List   as List
 import qualified Data.Map    as Map
 import qualified Data.Set    as Set
 import qualified Data.Vector as Vector
@@ -55,7 +50,7 @@ doesContains :: Eq a => [a] -> [a] -> Bool
 doesContains l l'
   | null l'               = True
   | length l' > length l  = False
-  | elem (head l') l      = doesContains l (tail l')
+  | elem (head' "doesContains" l') l      = doesContains l (tail l')
   | otherwise             = False
 
 
@@ -63,8 +58,8 @@ doesContains l l'
 doesContainsOrd :: Eq a => Ord a => [a] -> [a] -> Bool
 doesContainsOrd l l'
   | null l'          = False
-  | last l < head l' = False
-  | head l' `elem` l = True
+  | last l < (head' "doesContainsOrd" l') = False
+  | (head' "doesContainsOrd" l') `elem` l = True
   | otherwise        = doesContainsOrd l (tail l')
 
 
@@ -74,8 +69,8 @@ filterNestedSets h l l'
   | null l                 = if doesAnySetContains h l l'
                              then l'
                              else h : l'
-  | doesAnySetContains h l l' = filterNestedSets (head l) (tail l) l'
-  | otherwise              = filterNestedSets (head l) (tail l) (h : l')  
+  | doesAnySetContains h l l' = filterNestedSets (head' "filterNestedSets1" l) (tail l) l'
+  | otherwise              = filterNestedSets (head' "filterNestedSets2" l) (tail l) (h : l')
 
 
 
@@ -87,18 +82,23 @@ getKeyPair (x,y) m = case findPair (x,y) m of
                      where
                       --------------------------------------
                       findPair :: (Int,Int) -> Map (Int,Int) a -> Maybe (Int,Int)
-                      findPair (x,y) m
-                        | member (x,y) m = Just (x,y)
-                        | member (y,x) m = Just (y,x)
+                      findPair (x',y') m'
+                        | member (x',y') m' = Just (x',y')
+                        | member (y',x') m' = Just (y',x')
                         | otherwise      = Nothing
-                      --------------------------------------  
+                      --------------------------------------
 
 
 -- | To filter Fis with small Support but by keeping non empty Periods
-keepFilled :: (Int -> [a] -> [a]) -> Int -> [a] -> [a] 
+keepFilled :: (Int -> [a] -> [a]) -> Int -> [a] -> [a]
 keepFilled f thr l = if (null $ f thr l) && (not $ null l)
                      then keepFilled f (thr - 1) l
-                     else f thr l  
+                     else f thr l
+
+
+-- | To get all combinations of a list
+listToFullCombi :: Eq a => [a] -> [(a,a)]
+listToFullCombi l = [(x,y) | x <- l, y <- l]
 
 
 -- | To get all combinations of a list
@@ -106,11 +106,22 @@ listToDirectedCombi :: Eq a => [a] -> [(a,a)]
 listToDirectedCombi l = [(x,y) | x <- l, y <- l, x /= y]
 
 
+listToEqualCombi :: Eq a => [a] -> [(a,a)]
+listToEqualCombi l = [(x,y) | x <- l, y <- l, x == y]
+
+listToPairs :: Eq a => [a] -> [(a,a)]
+listToPairs l = (listToEqualCombi l) ++ (listToUnDirectedCombi l)
+
 -- | To get all combinations of a list and apply a function to the resulting list of pairs
 listToDirectedCombiWith :: Eq a => forall b. (a -> b) -> [a] -> [(b,b)]
 listToDirectedCombiWith f l = [(f x,f y) | x <- l, y <- l, x /= y]
 
 
+-- | To get the sequential combinations of an order list
+listToSequentialCombi :: Eq a => [a] -> [(a,a)]
+listToSequentialCombi l = nubBy (\x y -> fst x == fst y) $ listToUnDirectedCombi l
+
+
 -- | To get all combinations of a list with no repetition
 listToUnDirectedCombi :: [a] -> [(a,a)]
 listToUnDirectedCombi l = [ (x,y) | (x:rest) <- tails l,  y <- rest ]
@@ -118,109 +129,126 @@ listToUnDirectedCombi l = [ (x,y) | (x:rest) <- tails l,  y <- rest ]
 
 -- | To get all combinations of a list with no repetition and apply a function to the resulting list of pairs
 listToUnDirectedCombiWith :: forall a b. (a -> b) -> [a] -> [(b,b)]
-listToUnDirectedCombiWith f l = [ (f x, f y) | (x:rest) <- tails l,  y <- rest ] 
+listToUnDirectedCombiWith f l = [ (f x, f y) | (x:rest) <- tails l,  y <- rest ]
+
+
+-- | 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
+
+
+-- | To transform a list of Ngrams Indexes into a list of Text
+ngramsToText :: Vector Ngrams -> [Int] -> [Text]
+ngramsToText ngrams l = map (\idx -> ngrams Vector.! idx) l
+
+
+-- | To transform a list of ngrams into a list of indexes
+ngramsToIdx :: [Ngrams] -> Vector Ngrams -> [Int]
+ngramsToIdx ns v = sort $ map (\n -> getIdxInVector n v) ns
 
 
 -- | To unify the keys (x,y) that Map 1 share with Map 2 such as: (x,y) <=> (y,x)
 unifySharedKeys :: Eq a => Ord a => Map (a,a) b -> Map (a,a) b -> Map (a,a) b
 unifySharedKeys m1 m2 = mapKeys (\(x,y) -> if member (y,x) m2
                                            then (y,x)
-                                           else (x,y) ) m1                      
+                                           else (x,y) ) m1
 
 
 ---------------
 -- | Phylo | --
 ---------------
 
-
 -- | An analyzer ingests a Ngrams and generates a modified version of it
 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 -> PhyloPeaks -> PhyloParam -> Phylo
-initPhyloBase pds fds pks prm = Phylo ((fst . head) pds, (snd . last) pds) fds pks (map (\pd -> initPhyloPeriod pd []) pds) prm
+initPhyloBase :: [(Date, Date)] -> PhyloFoundations -> Map Date Double  -> Map Date (Map (Int,Int) Double) -> Map (Date,Date) [PhyloFis] -> PhyloParam -> Phylo
+initPhyloBase pds fds nbDocs cooc fis prm = Phylo ((fst . (head' "initPhyloBase")) pds, (snd . last) pds) fds (map (\pd -> initPhyloPeriod pd []) pds) nbDocs cooc fis prm
 
 -- | To init the param of a Phylo
-initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQuery -> PhyloParam
-initPhyloParam (def defaultPhyloVersion -> v) (def defaultSoftware -> s) (def defaultQuery -> 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
-
+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 last computed Level in a Phylo
-getLastLevel :: Phylo -> Level 
-getLastLevel p = (last . sort) 
-               $ map (snd . getPhyloLevelId) 
+getLastLevel :: Phylo -> Level
+getLastLevel p = (last . sort)
+               $ map (snd . getPhyloLevelId)
                $ view ( phylo_periods
                       .  traverse
                       . phylo_periodLevels ) p
 
+-- | To get all the coocurency matrix of a phylo
+getPhyloCooc :: Phylo -> Map Date (Map (Int,Int) Double)
+getPhyloCooc p = p ^. phylo_cooc
 
---------------------
--- | PhyloPeaks | --
---------------------
 
--- | 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) 
+-- | To get the PhyloParam of a Phylo
+getPhyloParams :: Phylo -> PhyloParam
+getPhyloParams = _phylo_param
 
--- | To transform a forest of trees into a map (node,root)
-forestToMap :: [Tree Ngrams] -> Map Ngrams Ngrams
-forestToMap trees = Map.fromList $ concat $ map (\(Node lbl ns) -> treeToTuples (Node lbl ns) lbl) trees
+-- | To get the title of a Phylo
+getPhyloTitle :: Phylo -> Text
+getPhyloTitle p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
 
--- | To get the foundationsPeaks of a Phylo
-getPeaks :: Phylo -> PhyloPeaks
-getPeaks = _phylo_foundationsPeaks 
+-- | To get the desc of a Phylo
+getPhyloDescription :: Phylo -> Text
+getPhyloDescription p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
 
--- | To get the peaksLabels of a Phylo
-getPeaksLabels :: Phylo -> Vector Ngrams
-getPeaksLabels p = (getPeaks p) ^. phylo_peaksLabels 
+getPhyloMatchingFrame :: Phylo -> Int
+getPhyloMatchingFrame p = _q_interTemporalMatchingFrame $ _phyloParam_query $ getPhyloParams p
 
--- | 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"
-    Just idx -> idx
+getPhyloMatchingFrameTh :: Phylo -> Double
+getPhyloMatchingFrameTh p = _q_interTemporalMatchingFrameTh $ _phyloParam_query $ getPhyloParams p
 
--- | To init the PhyloPeaks of a Phylo
-initPeaks :: [Tree Ngrams] -> Vector Ngrams -> PhyloPeaks
-initPeaks trees ns = PhyloPeaks 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
-    --------------------------------------
+getPhyloProximity :: Phylo -> Proximity
+getPhyloProximity p = _q_interTemporalMatching $ _phyloParam_query $ getPhyloParams p
+
+getPhyloReBranchThr :: Phylo -> Double
+getPhyloReBranchThr p = _q_reBranchThr $ _phyloParam_query $ getPhyloParams p
+
+getPhyloReBranchNth :: Phylo -> Int
+getPhyloReBranchNth p = _q_reBranchNth $ _phyloParam_query $ getPhyloParams p
 
--- | 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)
+getPhyloFis :: Phylo -> Map (Date,Date) [PhyloFis]
+getPhyloFis = _phylo_fis
 
 
 --------------------
--- | PhyloGroup | --
+-- | PhyloRoots | --
 --------------------
 
+-- | To get the foundations of a Phylo
+getFoundations :: Phylo -> PhyloFoundations
+getFoundations = _phylo_foundations
+
+-- | 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 (getFoundationsRoots p)) of
+    Nothing  -> panic $ "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots: " <> cs n
+    Just idx -> idx
+
+getIdxInRoots' :: Ngrams -> Vector Ngrams -> Int
+getIdxInRoots' n root = case (elemIndex n root) of
+    Nothing  -> panic $ "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots: " <> cs n
+    Just idx -> idx    
+
+getIdxInVector :: Ngrams -> Vector Ngrams -> Int
+getIdxInVector n ns = case (elemIndex n ns) of
+  Nothing  -> panic $ "[ERR][Viz.Phylo.Tools.getIdxInVector] Ngrams not in foundationsRoots: " <> cs n
+  Just idx -> idx
+
+--------------------
+-- | PhyloGroup | --
+--------------------
 
 -- | To alter a PhyloGroup matching a given Level
 alterGroupWithLevel :: (PhyloGroup -> PhyloGroup) -> Level -> Phylo -> Phylo
@@ -232,7 +260,7 @@ alterGroupWithLevel f lvl p = over ( phylo_periods
                                    .  traverse
                                    ) (\g -> if getGroupLevel g == lvl
                                             then f g
-                                            else g ) p  
+                                            else g ) p
 
 
 -- | To alter each list of PhyloGroups following a given function
@@ -242,7 +270,7 @@ alterPhyloGroups f p = over ( phylo_periods
                             . phylo_periodLevels
                             .  traverse
                             . phylo_levelGroups
-                            ) f p 
+                            ) f p
 
 
 -- | To filter the PhyloGroup of a Phylo according to a function and a value
@@ -252,7 +280,7 @@ filterGroups f x l = filter (\g -> (f g) == x) l
 
 -- | To maybe get the PhyloBranchId of a PhyloGroup
 getGroupBranchId :: PhyloGroup -> Maybe PhyloBranchId
-getGroupBranchId = _phylo_groupBranchId 
+getGroupBranchId = _phylo_groupBranchId
 
 
 -- | To get the PhyloGroups Childs of a PhyloGroup
@@ -265,7 +293,6 @@ getGroupId :: PhyloGroup -> PhyloGroupId
 getGroupId = _phylo_groupId
 
 
--- | To get the Cooc Matrix of a PhyloGroup
 getGroupCooc :: PhyloGroup -> Map (Int,Int) Double
 getGroupCooc = _phylo_groupCooc
 
@@ -295,6 +322,15 @@ getGroupLevelParentsId :: PhyloGroup -> [PhyloGroupId]
 getGroupLevelParentsId g = map fst $ getGroupLevelParents g
 
 
+-- | To get the PhyloGroups Level Parents Ids of a PhyloGroup
+getGroupLevelParentId :: PhyloGroup -> PhyloGroupId
+getGroupLevelParentId g = (head' "getGroupLevelParentId") $ getGroupLevelParentsId g
+
+-- | To get the Meta value of a PhyloGroup
+getGroupMeta :: Text -> PhyloGroup -> Double
+getGroupMeta k g = (g ^. phylo_groupMeta) ! k
+
+
 -- | To get the Ngrams of a PhyloGroup
 getGroupNgrams :: PhyloGroup -> [Int]
 getGroupNgrams =  _phylo_groupNgrams
@@ -335,24 +371,52 @@ getGroupPeriodParentsId :: PhyloGroup -> [PhyloGroupId]
 getGroupPeriodParentsId g = map fst $ getGroupPeriodParents g
 
 
+-- | To get the pointers of a given Phylogroup
+getGroupPointers :: EdgeType -> Filiation -> PhyloGroup -> [Pointer]
+getGroupPointers t f g = case t of
+                          PeriodEdge -> case f of 
+                                          Ascendant  -> getGroupPeriodParents g
+                                          Descendant -> getGroupPeriodChilds g
+                                          _          -> panic "[ERR][Viz.Phylo.Tools.getGroupPointers] wrong filiation"
+                          LevelEdge  -> case f of 
+                                          Ascendant  -> getGroupLevelParents g
+                                          Descendant -> getGroupLevelChilds g
+                                          _          -> panic "[ERR][Viz.Phylo.Tools.getGroupPointers] wrong filiation"
+
+
+-- | To get the roots labels of a list of group ngrams
+getGroupText :: PhyloGroup -> Phylo -> [Text] 
+getGroupText g p = ngramsToText (getFoundationsRoots p) (getGroupNgrams g) 
+
+
 -- | To get all the PhyloGroup of a Phylo
 getGroups :: Phylo -> [PhyloGroup]
 getGroups = view ( phylo_periods
                  .  traverse
                  . phylo_periodLevels
-                 .  traverse 
+                 .  traverse
                  . phylo_levelGroups
                  )
 
 
--- | To get all PhyloGroups matching a list of PhyloGroupIds in a Phylo
+-- | To get all PhyloGroups matching a list of PhyloGoupIds in a Phylo
+-- getGroupsFromIds :: [PhyloGroupId] -> Phylo -> [PhyloGroup]
+-- getGroupsFromIds ids p = filter (\g -> elem (getGroupId g) ids) $ getGroups p
+
+getGroupFromId :: PhyloGroupId -> Phylo -> PhyloGroup
+getGroupFromId id p = 
+  let groups = Map.fromList $ map (\g -> (getGroupId g, g)) $ getGroups p
+  in  groups ! id 
+
 getGroupsFromIds :: [PhyloGroupId] -> Phylo -> [PhyloGroup]
-getGroupsFromIds ids p = filter (\g -> elem (getGroupId g) ids) $ getGroups p
+getGroupsFromIds ids p =
+  let groups = Map.fromList $ map (\g -> (getGroupId g, g)) $ getGroups p
+  in  elems $ restrictKeys groups (Set.fromList ids)
 
 
 -- | To get the corresponding list of PhyloGroups from a list of PhyloNodes
 getGroupsFromNodes :: [PhyloNode] -> Phylo -> [PhyloGroup]
-getGroupsFromNodes ns p = getGroupsFromIds (map getNodeId ns) p 
+getGroupsFromNodes ns p = getGroupsFromIds (map getNodeId ns) p
 
 
 -- | To get all the PhyloGroup of a Phylo with a given level and period
@@ -372,16 +436,35 @@ getGroupsWithPeriod :: (Date,Date) -> Phylo -> [PhyloGroup]
 getGroupsWithPeriod prd p = filterGroups getGroupPeriod prd (getGroups p)
 
 
--- | To create a PhyloGroup in a Phylo out of a list of Ngrams and a set of parameters 
+-- | To create a PhyloGroup in a Phylo out of a list of Ngrams and a set of parameters
 initGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> Phylo -> PhyloGroup
-initGroup ngrams lbl idx lvl from to p = PhyloGroup 
-  (((from, to), lvl), idx)
+initGroup ngrams lbl idx lvl from' to' p = PhyloGroup
+  (((from', to'), lvl), idx)
   lbl
-  (sort $ map (\x -> getIdxInPeaks x p) ngrams)
+  idxs
   (Map.empty)
   (Map.empty)
   Nothing
+  (getMiniCooc (listToFullCombi idxs) (periodsToYears [(from', to')]) (getPhyloCooc p))
   [] [] [] []
+  where 
+    idxs = sort $ map (\x -> getIdxInRoots x p) ngrams
+
+
+-- | To sum two coocurency Matrix
+sumCooc :: Map (Int, Int) Double ->  Map (Int, Int) Double ->  Map (Int, Int) Double
+sumCooc m m' = unionWith (+) m m'
+
+-- | To build the mini cooc matrix of each group
+getMiniCooc :: [(Int,Int)] -> Set Date -> Map Date (Map (Int,Int) Double) -> Map (Int,Int) Double
+getMiniCooc pairs years cooc = filterWithKey (\(n,n') _ -> elem (n,n') pairs) cooc'
+  where 
+    --------------------------------------
+    cooc' :: Map (Int,Int) Double
+    cooc' = foldl (\m m' -> sumCooc m m') empty 
+          $ elems 
+          $ restrictKeys cooc years
+    --------------------------------------
 
 
 ---------------------
@@ -402,13 +485,13 @@ appendToPhyloPeriods l p = over (phylo_periods) (++ l) p
 
 -- | To get all the PhyloPeriodIds of a Phylo
 getPhyloPeriods :: Phylo -> [PhyloPeriodId]
-getPhyloPeriods p = map _phylo_periodId 
+getPhyloPeriods p = map _phylo_periodId
                   $ view (phylo_periods) p
 
 
 -- | To get the id of a given PhyloPeriod
 getPhyloPeriodId :: PhyloPeriod -> PhyloPeriodId
-getPhyloPeriodId prd = _phylo_periodId prd 
+getPhyloPeriodId prd = _phylo_periodId prd
 
 
 -- | To create a PhyloPeriod
@@ -416,6 +499,12 @@ initPhyloPeriod :: PhyloPeriodId -> [PhyloLevel] -> PhyloPeriod
 initPhyloPeriod id l = PhyloPeriod id l
 
 
+-- | To transform a list of periods into a set of Dates
+periodsToYears :: [(Date,Date)] -> Set Date
+periodsToYears periods = (Set.fromList . sort . concat)
+                       $ map (\(d,d') -> [d..d']) periods
+
+
 --------------------
 -- | PhyloLevel | --
 --------------------
@@ -445,10 +534,30 @@ initPhyloLevel id groups = PhyloLevel id groups
 
 -- | To set the LevelId of a PhyloLevel and of all its PhyloGroups
 setPhyloLevelId :: Int -> PhyloLevel -> PhyloLevel
-setPhyloLevelId lvl' (PhyloLevel (id, lvl) groups)
+setPhyloLevelId lvl' (PhyloLevel (id, _lvl) groups)
     = PhyloLevel (id, lvl') groups'
-        where 
-            groups' = over (traverse . phylo_groupId) (\((period, lvl), idx) -> ((period, lvl'), idx)) groups 
+        where
+            groups' = over (traverse . phylo_groupId)
+                           (\((period, _lvl), idx) -> ((period, lvl'), idx))
+                           groups
+
+
+------------------
+-- | PhyloFis | --
+------------------
+
+
+-- | To get the clique of a PhyloFis
+getClique :: PhyloFis -> Clique
+getClique = _phyloFis_clique
+
+-- | To get the support of a PhyloFis
+getSupport :: PhyloFis -> Support
+getSupport = _phyloFis_support
+
+-- | To get the period of a PhyloFis
+getFisPeriod :: PhyloFis -> (Date,Date)
+getFisPeriod = _phyloFis_period
 
 
 ----------------------------
@@ -456,30 +565,41 @@ setPhyloLevelId lvl' (PhyloLevel (id, lvl) groups)
 ----------------------------
 
 
+-- | To alter a PhyloNode
+alterPhyloNode :: (PhyloNode -> PhyloNode) -> PhyloView -> PhyloView
+alterPhyloNode f v = over ( pv_nodes
+                          .  traverse
+                          ) (\pn ->  f pn ) v
+
+
 -- | To filter some GroupEdges with a given threshold
-filterGroupEdges :: Double -> GroupEdges -> GroupEdges
-filterGroupEdges thr edges = filter (\((s,t),w) -> w > thr) edges 
+filterGroupEdges :: Double -> [GroupEdge] -> [GroupEdge]
+filterGroupEdges thr edges = filter (\((_s,_t),w) -> w > thr) edges
 
 
--- | To get the neighbours (directed/undirected) of a PhyloGroup from a list of GroupEdges 
-getNeighbours :: Bool -> PhyloGroup -> GroupEdges -> [PhyloGroup]
-getNeighbours directed g e = case directed of 
-  True  -> map (\((s,t),w) -> t) 
-             $ filter (\((s,t),w) -> s == g) e 
-  False -> map (\((s,t),w) -> head $ delete g $ nub [s,t,g]) 
-             $ filter (\((s,t),w) -> s == g || t == g) e
+-- | To get the neighbours (directed/undirected) of a PhyloGroup from a list of GroupEdges
+getNeighbours :: Bool -> PhyloGroup -> [GroupEdge] -> [PhyloGroup]
+getNeighbours directed g e = case directed of
+  True  -> map (\((_s,t),_w) -> t)
+             $ filter (\((s,_t),_w) -> s == g) e
+  False -> map (\((s,t),_w) -> (head' "getNeighbours") $ delete g $ nub [s,t,g])
+             $ filter (\((s,t),_w) -> s == g || t == g) e
 
 
 -- | To get the PhyloBranchId of PhyloNode if it exists
 getNodeBranchId :: PhyloNode -> PhyloBranchId
-getNodeBranchId n = case n ^. phylo_nodeBranchId of
+getNodeBranchId n = case n ^. pn_bid of
                      Nothing -> panic "[ERR][Viz.Phylo.Tools.getNodeBranchId] branchId not found"
-                     Just i  -> i 
+                     Just i  -> i
 
 
 -- | To get the PhyloGroupId of a PhyloNode
 getNodeId :: PhyloNode -> PhyloGroupId
-getNodeId n = n ^. phylo_nodeId
+getNodeId n = n ^. pn_id
+
+
+getNodePeriod :: PhyloNode -> (Date,Date)
+getNodePeriod n = fst $ fst $ getNodeId n
 
 
 -- | To get the Level of a PhyloNode
@@ -490,41 +610,41 @@ getNodeLevel n = (snd . fst) $ getNodeId n
 -- | To get the Parent Node of a PhyloNode in a PhyloView
 getNodeParent :: PhyloNode -> PhyloView -> [PhyloNode]
 getNodeParent n v = filter (\n' -> elem (getNodeId n') (getNodeParentsId n))
-                  $ v ^. phylo_viewNodes
+                  $ v ^. pv_nodes
 
 
 -- | To get the Parent Node id of a PhyloNode if it exists
 getNodeParentsId :: PhyloNode -> [PhyloGroupId]
-getNodeParentsId n = case n ^. phylo_nodeLevelParents of
+getNodeParentsId n = case n ^. pn_parents of
                     Nothing  -> panic "[ERR][Viz.Phylo.Tools.getNodeParentsId] node parent not found"
                     Just ids -> ids
 
 
 -- | To get a list of PhyloNodes grouped by PhyloBranch in a PhyloView
 getNodesByBranches :: PhyloView -> [(PhyloBranchId,[PhyloNode])]
-getNodesByBranches v = zip bIds $ map (\id -> filter (\n -> (getNodeBranchId n) == id) 
+getNodesByBranches v = zip bIds $ map (\id -> filter (\n -> (getNodeBranchId n) == id)
                                             $ getNodesInBranches v ) bIds
   where
-    -------------------------------------- 
-    bIds :: [PhyloBranchId] 
-    bIds = getViewBranchIds v 
+    --------------------------------------
+    bIds :: [PhyloBranchId]
+    bIds = getViewBranchIds v
     --------------------------------------
 
 
 -- | To get a list of PhyloNodes owned by any PhyloBranches in a PhyloView
 getNodesInBranches :: PhyloView -> [PhyloNode]
-getNodesInBranches v = filter (\n -> isJust $ n ^. phylo_nodeBranchId)
-                     $ v ^. phylo_viewNodes
+getNodesInBranches v = filter (\n -> isJust $ n ^. pn_bid)
+                     $ v ^. pv_nodes
 
 
--- | To get the PhyloGroupId of the Source of a PhyloEdge 
+-- | To get the PhyloGroupId of the Source of a PhyloEdge
 getSourceId :: PhyloEdge -> PhyloGroupId
-getSourceId e = e ^. phylo_edgeSource 
+getSourceId e = e ^. pe_source
 
 
 -- | To get the PhyloGroupId of the Target of a PhyloEdge
 getTargetId :: PhyloEdge -> PhyloGroupId
-getTargetId e = e ^. phylo_edgeTarget                     
+getTargetId e = e ^. pe_target
 
 
 ---------------------
@@ -534,7 +654,14 @@ getTargetId e = e ^. phylo_edgeTarget
 
 -- | To get the PhyloBranchId of a PhyloBranch
 getBranchId :: PhyloBranch -> PhyloBranchId
-getBranchId b = b ^. phylo_branchId
+getBranchId b = b ^. pb_id
+
+-- | To get a list of PhyloBranchIds
+getBranchIds :: Phylo -> [PhyloBranchId]
+getBranchIds p = sortOn snd
+               $ nub 
+               $ mapMaybe getGroupBranchId
+               $ getGroups p
 
 
 -- | To get a list of PhyloBranchIds given a Level in a Phylo
@@ -544,100 +671,192 @@ getBranchIdsWith lvl p = sortOn snd
                        $ getGroupsWithLevel lvl p
 
 
--- | To get the Meta value of a PhyloBranch 
-getBranchMeta :: Text -> PhyloBranch -> [Double] 
-getBranchMeta k b = (b ^. phylo_branchMetrics) ! k
+-- | To get the Meta value of a PhyloBranch
+getBranchMeta :: Text -> PhyloBranch -> [Double]
+getBranchMeta k b = (b ^. pb_metrics) ! k
 
 
 -- | To get all the PhyloBranchIds of a PhyloView
 getViewBranchIds :: PhyloView -> [PhyloBranchId]
-getViewBranchIds v = map getBranchId $ v ^. phylo_viewBranches
+getViewBranchIds v = map getBranchId $ v ^. pv_branches
+
+
+-- | To get a list of PhyloGroup sharing the same PhyloBranchId
+getGroupsByBranches :: Phylo -> [(PhyloBranchId,[PhyloGroup])]
+getGroupsByBranches p = zip (getBranchIds p) 
+                      $ map (\id -> filter (\g -> (fromJust $ getGroupBranchId g) == id)
+                                    $ getGroupsInBranches p) 
+                      $ getBranchIds p 
+
+
+-- | To get the sublist of all the PhyloGroups linked to a branch
+getGroupsInBranches :: Phylo -> [PhyloGroup]
+getGroupsInBranches p = filter (\g -> isJust $ g ^. phylo_groupBranchId)
+                      $ getGroups p
 
 
 --------------------------------
 -- | PhyloQuery & QueryView | --
 --------------------------------
 
--- | To get the first clustering method to apply to get the level 1 of a Phylo
-getFstCluster :: PhyloQuery -> Cluster
-getFstCluster q = q ^. q_contextualUnit
+
+-- | To filter PhyloView's Branches by level
+filterBranchesByLevel :: Level -> PhyloView -> [PhyloBranch]
+filterBranchesByLevel lvl pv = filter (\pb -> lvl == (fst $ pb ^. pb_id)) 
+                          $ pv ^. pv_branches
+
+
+-- | To filter PhyloView's Edges by level
+filterEdgesByLevel :: Level -> [PhyloEdge] -> [PhyloEdge]
+filterEdgesByLevel lvl pes = filter (\pe -> (lvl == ((snd . fst) $ pe ^. pe_source))
+                                         && (lvl == ((snd . fst) $ pe ^. pe_target))) pes
+
+
+-- | To filter PhyloView's Edges by type
+filterEdgesByType :: EdgeType -> [PhyloEdge] -> [PhyloEdge]
+filterEdgesByType t pes = filter (\pe -> t == (pe ^. pe_type)) pes
+
+
+-- | To filter PhyloView's Nodes by the oldest Period
+filterNodesByFirstPeriod :: [PhyloNode] -> [PhyloNode]
+filterNodesByFirstPeriod pns = filter (\pn -> fstPrd == ((fst . fst) $ pn ^. pn_id)) pns
+    where 
+        --------------------------------------
+        fstPrd :: (Date,Date)
+        fstPrd = (head' "filterNodesByFirstPeriod")
+               $ sortOn fst 
+               $ map (\pn -> (fst . fst) $ pn ^. pn_id) pns 
+        --------------------------------------
+
+
+-- | To filter PhyloView's Nodes by Branch
+filterNodesByBranch :: PhyloBranchId -> [PhyloNode] -> [PhyloNode]
+filterNodesByBranch bId pns = filter (\pn -> if isJust $ pn ^. pn_bid
+                                             then if bId == (fromJust $ pn ^. pn_bid)
+                                                  then True
+                                                  else False
+                                             else False ) pns           
+
+
+-- | To filter PhyloView's Nodes by level
+filterNodesByLevel :: Level -> [PhyloNode] -> [PhyloNode]
+filterNodesByLevel lvl pns = filter (\pn -> lvl == ((snd . fst) $ pn ^. pn_id)) pns
+
+
+-- | To filter PhyloView's Nodes by Period
+filterNodesByPeriod :: PhyloPeriodId -> [PhyloNode] -> [PhyloNode]
+filterNodesByPeriod prd pns = filter (\pn -> prd == ((fst . fst) $ pn ^. pn_id)) pns
+
+
+-- | To get the first clustering method to apply to get the contextual units of a Phylo
+getContextualUnit :: PhyloQueryBuild -> Cluster
+getContextualUnit q = q ^. q_contextualUnit
+
+
+-- | To get the metrics to apply to contextual units
+getContextualUnitMetrics :: PhyloQueryBuild -> [Metric]
+getContextualUnitMetrics q = q ^. q_contextualUnitMetrics
+
+
+-- | To get the filters to apply to contextual units
+getContextualUnitFilters :: PhyloQueryBuild -> [Filter]
+getContextualUnitFilters q = q ^. q_contextualUnitFilters
 
 
 -- | To get the cluster methods to apply to the Nths levels of a Phylo
-getNthCluster :: PhyloQuery -> Cluster
+getNthCluster :: PhyloQueryBuild -> Cluster
 getNthCluster q = q ^. q_nthCluster
 
 
 -- | To get the Sup Level of a reconstruction of a Phylo from a PhyloQuery
-getNthLevel :: PhyloQuery -> Level
+getNthLevel :: PhyloQueryBuild -> Level
 getNthLevel q = q ^. q_nthLevel
 
 
 -- | To get the Grain of the PhyloPeriods from a PhyloQuery
-getPeriodGrain :: PhyloQuery -> Int
-getPeriodGrain q = q ^. q_periodGrain 
+getPeriodGrain :: PhyloQueryBuild -> Int
+getPeriodGrain q = q ^. q_periodGrain
 
 
 -- | To get the intertemporal matching strategy to apply to a Phylo from a PhyloQuery
-getInterTemporalMatching :: PhyloQuery -> Proximity
+getInterTemporalMatching :: PhyloQueryBuild -> Proximity
 getInterTemporalMatching q = q ^. q_interTemporalMatching
 
 
 -- | To get the Steps of the PhyloPeriods from a PhyloQuery
-getPeriodSteps :: PhyloQuery -> Int 
+getPeriodSteps :: PhyloQueryBuild -> Int
 getPeriodSteps q = q ^. q_periodSteps
 
 
 --------------------------------------------------
--- | PhyloQuery & PhyloQueryView Constructors | --
+-- | PhyloQueryBuild & PhyloQueryView Constructors | --
 --------------------------------------------------
 
+-- | To get the threshold of a Proximity
+getThreshold :: Proximity -> Double
+getThreshold prox = case prox of 
+  WeightedLogJaccard (WLJParams thr _) -> thr
+  Hamming (HammingParams thr)          -> thr
+  Filiation                            -> panic "[ERR][Viz.Phylo.Tools.getThreshold] Filiation"
+
 
 -- | To get the Proximity associated to a given Clustering method
 getProximity :: Cluster -> Proximity
-getProximity cluster = case cluster of 
+getProximity cluster = case cluster of
   Louvain (LouvainParams proxi)      -> proxi
   RelatedComponents (RCParams proxi) -> proxi
   _   -> panic "[ERR][Viz.Phylo.Tools.getProximity] this cluster has no associated Proximity"
 
 
 -- | To initialize all the Cluster / Proximity with their default parameters
-initFis :: Maybe Bool -> Maybe Bool -> Maybe Support -> FisParams
-initFis (def True -> flt) (def True -> kmf) (def 1 -> min) = FisParams flt kmf min
+initFis :: Maybe Bool -> Maybe Support -> Maybe Int -> FisParams
+initFis (def True -> kmf) (def 0 -> min') (def 0 -> thr) = FisParams kmf min' thr
 
 initHamming :: Maybe Double -> HammingParams
 initHamming (def 0.01 -> sens) = HammingParams sens
 
-initSmallBranch :: Maybe Int -> Maybe Int -> Maybe Int -> SBParams
-initSmallBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = SBParams periodsInf periodsSup minNodes
+initLonelyBranch :: Maybe Int -> Maybe Int -> Maybe Int -> LBParams
+initLonelyBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = LBParams periodsInf periodsSup minNodes
+
+initSizeBranch :: Maybe Int -> SBParams
+initSizeBranch (def 1 -> minSize) = SBParams minSize
+
+initLonelyBranch' :: Maybe Int -> Maybe Int -> Maybe Int -> LBParams
+initLonelyBranch' (def 0 -> periodsInf) (def 0 -> periodsSup) (def 1 -> minNodes) = LBParams periodsInf periodsSup minNodes
 
 initLouvain :: Maybe Proximity -> LouvainParams
 initLouvain (def defaultWeightedLogJaccard -> proxi) = LouvainParams proxi
 
 initRelatedComponents :: Maybe Proximity -> RCParams
-initRelatedComponents (def Filiation -> proxi) = RCParams proxi
+initRelatedComponents (def defaultWeightedLogJaccard -> proxi) = RCParams proxi
 
+-- | TODO user param in main function
 initWeightedLogJaccard :: Maybe Double -> Maybe Double -> WLJParams
-initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
+initWeightedLogJaccard (def 0.3 -> thr) (def 20.0 -> sens) = WLJParams thr sens
 
 
--- | To initialize a PhyloQuery from given and default parameters
-initPhyloQuery :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQuery
-initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster)
-  (def defaultWeightedLogJaccard -> matching) (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
-    PhyloQuery name desc grain steps cluster matching nthLevel nthCluster
+-- | 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 Int
+                    -> Maybe Double  -> Maybe Double    -> Maybe Int
+                    -> Maybe Level   -> Maybe Cluster   -> PhyloQueryBuild
+initPhyloQueryBuild name desc (def 5 -> grain)
+                    (def 1 -> steps)      (def defaultFis -> cluster) (def [] -> metrics)
+                    (def [] -> filters)   (def defaultWeightedLogJaccard -> matching') (def 5 -> frame)
+                    (def 0.8 -> frameThr) (def 0.5 -> reBranchThr) (def 4 -> reBranchNth)
+                    (def 2 -> nthLevel)   (def defaultRelatedComponents -> nthCluster) =
+    PhyloQueryBuild name  desc    grain
+                    steps cluster metrics filters matching' frame frameThr reBranchThr reBranchNth nthLevel nthCluster
 
 
 -- | To initialize a PhyloQueryView default parameters
-initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
-initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Flat -> dm) (def True -> v) =
-  PhyloQueryView lvl f c d ms fs ts s dm v
+initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe ExportMode -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
+initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Json -> em) (def Flat -> dm) (def True -> v) =
+  PhyloQueryView lvl f c d ms fs ts s em dm v
 
 
 -- | To define some obvious boolean getters
-shouldFilterFis :: FisParams -> Bool
-shouldFilterFis = _fis_filtered
-
 shouldKeepMinorFis :: FisParams -> Bool
 shouldKeepMinorFis = _fis_keepMinorFis
 
@@ -658,10 +877,13 @@ defaultRelatedComponents = RelatedComponents (initRelatedComponents Nothing)
 
 -- Filters
 
-defaultSmallBranch :: Filter
-defaultSmallBranch = SmallBranch (initSmallBranch Nothing Nothing Nothing)
+defaultLonelyBranch :: Filter
+defaultLonelyBranch = LonelyBranch (initLonelyBranch Nothing Nothing Nothing)
+
+defaultSizeBranch :: Filter
+defaultSizeBranch = SizeBranch (initSizeBranch Nothing)
 
--- Params 
+-- Params
 
 defaultPhyloParam :: PhyloParam
 defaultPhyloParam = initPhyloParam Nothing Nothing Nothing
@@ -675,24 +897,35 @@ defaultWeightedLogJaccard :: Proximity
 defaultWeightedLogJaccard = WeightedLogJaccard (initWeightedLogJaccard Nothing Nothing)
 
 -- Queries
+type Title = Text
+type Desc  = Text
+
+defaultQueryBuild :: PhyloQueryBuild
+defaultQueryBuild = defaultQueryBuild'
+  "Cesar et Cleôpatre"
+  "An example of Phylomemy (french without accent)"
 
-defaultQuery :: PhyloQuery
-defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)" 
-                              Nothing Nothing Nothing Nothing Nothing Nothing
+defaultQueryBuild' :: Title -> Desc -> PhyloQueryBuild
+defaultQueryBuild' t d = initPhyloQueryBuild t d
+                              Nothing Nothing Nothing
+                              Nothing Nothing Nothing
+                              Nothing Nothing Nothing
+                              Nothing Nothing Nothing
 
 defaultQueryView :: PhyloQueryView
-defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing                              
+defaultQueryView = initPhyloQueryView
+    Nothing Nothing Nothing
+    Nothing Nothing Nothing
+    Nothing Nothing Nothing
+    Nothing Nothing
 
 -- Software
 
 defaultSoftware :: Software
 defaultSoftware = Software "Gargantext" "v4"
 
--- Version 
+-- Version
 
 defaultPhyloVersion :: Text
 defaultPhyloVersion = "v1"
 
-
-
-