Add the new branches definition

src/Gargantext/Viz/Phylo.hs

@@ -121,8 +121,9 @@ data PhyloGroup =
      PhyloGroup { _phylo_groupId            :: PhyloGroupId
                 , _phylo_groupLabel         :: Text
                 , _phylo_groupNgrams        :: [Int]
-                , _phylo_groupQuality       :: Map Text Double
+                , _phylo_groupMeta          :: Map Text Double
                 , _phylo_groupCooc          :: Map (Int, Int) Double
+                , _phylo_groupBranchId      :: Maybe PhyloBranchId
                 
                 , _phylo_groupPeriodParents :: [Pointer]
                 , _phylo_groupPeriodChilds  :: [Pointer]
@@ -132,13 +133,6 @@ data PhyloGroup =
                 }
                 deriving (Generic, Show, Eq, Ord)             
 
-data PhyloBranch =
-     PhyloBranch { _phylo_branchId     :: (Level,Int)
-                 , _phylo_branchLabel  :: Text
-                 , _phylo_branchGroups :: [PhyloGroupId] 
-                 }
-                 deriving (Generic, Show)                
-
 
 -- | Level : A level of aggregation (-1 = Txt, 0 = Ngrams, 1 = Fis, [2..] = Cluster)  
 type Level = Int 
@@ -233,14 +227,12 @@ makeLenses ''Software
 makeLenses ''PhyloGroup
 makeLenses ''PhyloLevel
 makeLenses ''PhyloPeriod
-makeLenses ''PhyloBranch
 
 -- | JSON instances
 $(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       ) 
 $(deriveJSON (unPrefix "_phylo_period" ) 'PhyloPeriod  )
 $(deriveJSON (unPrefix "_phylo_level"  ) ''PhyloLevel  )
 $(deriveJSON (unPrefix "_phylo_group"  ) ''PhyloGroup  )
-$(deriveJSON (unPrefix "_phylo_branch" ) ''PhyloBranch )
 -- 
 $(deriveJSON (unPrefix "_software_"    ) ''Software    )
 $(deriveJSON (unPrefix "_phyloParam_"  ) ''PhyloParam  )

src/Gargantext/Viz/Phylo/BranchMaker.hs

@@ -17,6 +17,8 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.BranchMaker
   where
 
+import Control.Lens     hiding (both, Level)
+
 import Data.List        (last,head,union,concat,null,nub,(++),init,tail,(!!))
 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith)
 import Data.Set         (Set)
@@ -34,9 +36,10 @@ import qualified Data.Set    as Set
 
 
 -- | To transform a PhyloGraph into a list of PhyloBranches by using the relatedComp clustering
-graphToBranches :: Level -> PhyloGraph -> Phylo -> [PhyloBranch]
-graphToBranches lvl (nodes,edges) p = map (\(idx,c) -> PhyloBranch (lvl,idx) "" (map getGroupId c)) 
-                                    $ zip [0..] 
+graphToBranches :: Level -> PhyloGraph -> Phylo -> [(Int,PhyloGroupId)]
+graphToBranches lvl (nodes,edges) p = concat 
+                                    $ map (\(idx,gs) -> map (\g -> (idx,getGroupId g)) gs)
+                                    $ zip [1..]
                                     $ relatedComp 0 (head nodes) (tail nodes,edges) [] []
 
 
@@ -60,5 +63,14 @@ groupsToGraph (prox,param) groups p = (groups,edges)
 
 
 -- | To set all the PhyloBranches for a given Level in a Phylo
--- setPhyloBranches :: Level -> Phylo -> Phylo 
--- setPhyloBranches lvl p = alterPhyloBranches (\l -> l ++ (graphToBranches lvl (groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p) p) ) p
\ No newline at end of file
+setPhyloBranches :: Level -> Phylo -> Phylo 
+setPhyloBranches lvl p = alterGroupWithLevel (\g -> let bIdx = (fst . head) $ filter (\b -> snd b == getGroupId g) bs
+                                                     in over (phylo_groupBranchId) (\x -> Just (lvl,bIdx)) g) lvl p
+  where
+    --------------------------------------
+    bs :: [(Int,PhyloGroupId)]
+    bs = graphToBranches lvl graph p
+    --------------------------------------
+    graph :: PhyloGraph
+    graph = groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p
+    --------------------------------------
\ No newline at end of file

src/Gargantext/Viz/Phylo/Example.hs

@@ -69,14 +69,14 @@ import qualified Data.Vector as Vector
 -- | STEP 12 | -- Return a Phylo for upcomming visiualization tasks 
 
 
--- | To get all the single PhyloPeriodIds covered by a PhyloBranch
-getBranchPeriods :: PhyloBranch -> [PhyloPeriodId]
-getBranchPeriods b = nub $ map (fst . fst) $ getBranchGroupIds b 
+-- -- | To get all the single PhyloPeriodIds covered by a PhyloBranch
+-- getBranchPeriods :: PhyloBranch -> [PhyloPeriodId]
+-- getBranchPeriods b = nub $ map (fst . fst) $ getBranchGroupIds b 
 
 
--- | To get all the single PhyloPeriodIds covered by a PhyloBranch
-getBranchGroupIds :: PhyloBranch -> [PhyloGroupId]
-getBranchGroupIds =_phylo_branchGroups 
+-- -- | To get all the single PhyloPeriodIds covered by a PhyloBranch
+-- getBranchGroupIds :: PhyloBranch -> [PhyloGroupId]
+-- getBranchGroupIds =_phylo_branchGroups 
 
 
 -- | To transform a list of Ngrams Indexes into a Label
@@ -114,15 +114,15 @@ freqToLabel thr l ngs = ngramsToLabel ngs $ mostFreqNgrams thr l
 
 
 -- | To filter a list of Branches by avoiding the lone's one (ie: with just a few phyloGroups in the middle of the whole timeline)
-filterLoneBranches :: Int -> Int -> Int -> [PhyloPeriodId] -> [PhyloBranch] -> [PhyloBranch]
-filterLoneBranches nbPinf nbPsup nbG periods branches = filter (not . isLone) branches
-  where
-    --------------------------------------
-    isLone :: PhyloBranch -> Bool
-    isLone b = ((length . getBranchGroupIds) b <= nbG)
-               && notElem ((head . getBranchPeriods) b) (take nbPinf periods)
-               && notElem ((head . getBranchPeriods) b) (take nbPsup $ reverse periods)
-    --------------------------------------
+-- filterLoneBranches :: Int -> Int -> Int -> [PhyloPeriodId] -> [PhyloBranch] -> [PhyloBranch]
+-- filterLoneBranches nbPinf nbPsup nbG periods branches = filter (not . isLone) branches
+--   where
+--     --------------------------------------
+--     isLone :: PhyloBranch -> Bool
+--     isLone b = ((length . getBranchGroupIds) b <= nbG)
+--                && notElem ((head . getBranchPeriods) b) (take nbPinf periods)
+--                && notElem ((head . getBranchPeriods) b) (take nbPsup $ reverse periods)
+--     --------------------------------------
 
 -- alterBranchLabel :: (Int -> [PhyloGroup] -> Vector Ngrams -> Text) -> PhyloBranch -> Phylo -> PhyloBranch
 -- alterBranchLabel f b p = over (phylo_branchLabel) (\lbl -> f 2 (getGroupsFromIds (getBranchGroupIds b) p) (getVector Ngrams p)) b
@@ -146,8 +146,9 @@ phylo6 = toNthLevel 6 (WeightedLogJaccard,[0.01,0]) (RelatedComponents, []) (Wei
 
 
 phylo3 :: Phylo
-phylo3 = pairGroupsToGroups Childs  3 (WeightedLogJaccard,[0.01,0])
-       $ pairGroupsToGroups Parents 3 (WeightedLogJaccard,[0.01,0]) 
+phylo3 = setPhyloBranches 3
+       $ interTempoMatching Childs  3 (WeightedLogJaccard,[0.01,0])
+       $ interTempoMatching Parents 3 (WeightedLogJaccard,[0.01,0]) 
        $ setLevelLinks (2,3) 
        $ addPhyloLevel 3 
           (phyloToClusters 2 (WeightedLogJaccard,[0.01,0]) (RelatedComponents, []) phyloBranch2) 
@@ -158,16 +159,15 @@ phylo3 = pairGroupsToGroups Childs  3 (WeightedLogJaccard,[0.01,0])
 -- | STEP 10 | -- Cluster the Fis
 
 phyloBranch2 :: Phylo
-phyloBranch2 = phylo2_c
--- phyloBranch2 = setPhyloBranches 2 phylo2_c
+phyloBranch2 = setPhyloBranches 2 phylo2_c
 
 
 phylo2_c :: Phylo
-phylo2_c = pairGroupsToGroups Childs 2 (WeightedLogJaccard,[0.01,0]) phylo2_p
+phylo2_c = interTempoMatching Childs 2 (WeightedLogJaccard,[0.01,0]) phylo2_p
 
 
 phylo2_p :: Phylo
-phylo2_p = pairGroupsToGroups Parents 2 (WeightedLogJaccard,[0.01,0]) phylo2_1_2
+phylo2_p = interTempoMatching Parents 2 (WeightedLogJaccard,[0.01,0]) phylo2_1_2
 
 
 phylo2_1_2 :: Phylo
@@ -187,10 +187,8 @@ phyloCluster = phyloToClusters 1 (WeightedLogJaccard,[0.01,0]) (RelatedComponent
 -- | STEP 9 | -- Find the Branches
 
 
-phyloBranch1 = phylo1_c
-
--- phyloBranch1 :: Phylo
--- phyloBranch1 = setPhyloBranches 1 phylo1_c
+phyloBranch1 :: Phylo
+phyloBranch1 = setPhyloBranches 1 phylo1_c
 
 
 ------------------------------------------------------------------------
@@ -198,11 +196,11 @@ phyloBranch1 = phylo1_c
 
 
 phylo1_c :: Phylo
-phylo1_c = pairGroupsToGroups Childs 1 (WeightedLogJaccard,[0.01,0]) phylo1_p
+phylo1_c = interTempoMatching Childs 1 (WeightedLogJaccard,[0.01,0]) phylo1_p
 
 
 phylo1_p :: Phylo
-phylo1_p = pairGroupsToGroups Parents 1 (WeightedLogJaccard,[0.01,0]) phylo1_0_1
+phylo1_p = interTempoMatching Parents 1 (WeightedLogJaccard,[0.01,0]) phylo1_0_1
 
 
 ------------------------------------------------------------------------

src/Gargantext/Viz/Phylo/LevelMaker.hs

@@ -93,7 +93,7 @@ instance PhyloLevelMaker Document
 -- | To transform a Cluster into a Phylogroup 
 clusterToGroup :: PhyloPeriodId -> Level -> Int -> Text -> Cluster -> Map (Date,Date) [Cluster] -> Phylo -> PhyloGroup
 clusterToGroup prd lvl idx lbl groups m p = 
-    PhyloGroup ((prd, lvl), idx) lbl ngrams empty cooc [] [] [] (map (\g -> (getGroupId g, 1)) groups)
+    PhyloGroup ((prd, lvl), idx) lbl ngrams empty cooc Nothing [] [] [] (map (\g -> (getGroupId g, 1)) groups)
       where
         --------------------------------------
         ngrams :: [Int]
@@ -110,7 +110,7 @@ clusterToGroup prd lvl idx lbl groups m p =
 -- | To transform a Clique into a PhyloGroup
 cliqueToGroup :: PhyloPeriodId -> Level -> Int -> Text -> (Clique,Support) -> Map (Date, Date) [Fis] -> Phylo -> PhyloGroup
 cliqueToGroup prd lvl idx lbl fis m p = 
-    PhyloGroup ((prd, lvl), idx) lbl ngrams (singleton "support" (fromIntegral $ snd fis)) cooc [] [] [] []
+    PhyloGroup ((prd, lvl), idx) lbl ngrams (singleton "support" (fromIntegral $ snd fis)) cooc Nothing [] [] [] []
       where
         --------------------------------------
         ngrams :: [Int]
@@ -127,7 +127,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 -> getIdxInFoundations x p) ngrams) empty empty [] [] [] []
+    PhyloGroup ((prd, lvl), idx) lbl (sort $ map (\x -> getIdxInFoundations x p) ngrams) empty empty Nothing [] [] [] []
 
 
 -- | To traverse a Phylo and add a new PhyloLevel linked to a new list of PhyloGroups
@@ -155,9 +155,9 @@ toNthLevel :: Level -> (Proximity,[Double]) -> (Clustering,[Double]) -> (Proximi
 toNthLevel lvlMax (prox,param1) (clus,param2) (prox',param3) p 
   | lvl >= lvlMax = p
   | otherwise     = toNthLevel lvlMax (prox,param1) (clus,param2) (prox',param3)
-                  -- $ setPhyloBranches (lvl + 1)                  
-                  $ pairGroupsToGroups Childs  (lvl + 1) (prox',param3)
-                  $ pairGroupsToGroups Parents (lvl + 1) (prox',param3)
+                  $ setPhyloBranches (lvl + 1)                  
+                  $ interTempoMatching Childs  (lvl + 1) (prox',param3)
+                  $ interTempoMatching Parents (lvl + 1) (prox',param3)
                   $ setLevelLinks (lvl, lvl + 1)
                   $ addPhyloLevel (lvl + 1)
                     (phyloToClusters lvl (prox,param1) (clus,param2) p) p

src/Gargantext/Viz/Phylo/LinkMaker.hs

@@ -161,8 +161,8 @@ makePair to group ids = case to of
 
 
 -- | To pair all the Phylogroups of given PhyloLevel to their best Parents or Childs
-pairGroupsToGroups :: PairTo -> Level -> (Proximity,[Double]) -> Phylo -> Phylo
-pairGroupsToGroups to lvl (prox,param) p = alterPhyloGroups
+interTempoMatching :: PairTo -> Level -> (Proximity,[Double]) -> Phylo -> Phylo
+interTempoMatching to lvl (prox,param) p = alterPhyloGroups
                                     (\groups -> 
                                       map (\group ->
                                             if (getGroupLevel group) == lvl

src/Gargantext/Viz/Phylo/Tools.hs

@@ -37,9 +37,17 @@ import qualified Data.Vector as Vector
 -- | Tools | --
 
 
--- | To add a new PhyloGroupId to a PhyloBranch
-addGroupIdToBranch :: PhyloGroupId -> PhyloBranch -> PhyloBranch
-addGroupIdToBranch id b = over (phylo_branchGroups) (++ [id]) b
+alterGroupWithLevel :: (PhyloGroup -> PhyloGroup) -> Level -> Phylo -> Phylo
+alterGroupWithLevel f lvl p = over ( phylo_periods
+                                   .  traverse
+                                   . phylo_periodLevels
+                                   .  traverse
+                                   . phylo_levelGroups
+                                   .  traverse
+                                   ) (\g -> if getGroupLevel g == lvl
+                                            then f g
+                                            else g ) p  
+
 
 
 -- | To alter each list of PhyloGroups following a given function
@@ -58,11 +66,6 @@ alterPhyloPeriods f p = over ( phylo_periods
                              .  traverse) f p
 
 
--- | To alter the list of PhyloBranches of a Phylo
--- alterPhyloBranches :: ([PhyloBranch] -> [PhyloBranch]) -> Phylo -> Phylo
--- alterPhyloBranches f p = over ( phylo_branches ) f p
-
-
 -- | To alter a list of PhyloLevels following a given function
 alterPhyloLevels :: ([PhyloLevel] -> [PhyloLevel]) -> Phylo -> Phylo
 alterPhyloLevels f p = over ( phylo_periods
@@ -279,6 +282,7 @@ initGroup ngrams lbl idx lvl from to p = PhyloGroup
   (sort $ map (\x -> getIdxInFoundations x p) ngrams)
   (Map.empty)
   (Map.empty)
+  Nothing
   [] [] [] []