working on phyloPeaks

src/Gargantext/Viz/Phylo.hs

@@ -75,11 +75,18 @@ data Software =
 data Phylo =
      Phylo { _phylo_duration    :: (Start, End)
            , _phylo_foundations :: Vector Ngrams
+           -- , _phylo_peaks       :: PhyloPeaks
            , _phylo_periods     :: [PhyloPeriod]
            , _phylo_param       :: PhyloParam
            }
            deriving (Generic, Show)
 
+-- data PhyloPeaks = 
+--       PhyloPeaks { _phylo_peaksLabel :: Vector Ngrams
+--                  , _phylo_peaksTrees :: [(Ngrams, TreeNgrams)]
+--                  } 
+--                  deriving (Generic, Show)  
+
 
 -- | Date : a simple Integer
 type Date = Int
@@ -270,13 +277,13 @@ data HammingParams = HammingParams
 
 
 -- | Filter constructors
-data Filter = LonelyBranch LBParams deriving (Show)
+data Filter = SmallBranch SBParams deriving (Show)
 
--- | Parameters for LonelyBranch filter
-data LBParams = LBParams
-  { _lb_periodsInf :: Int 
-  , _lb_periodsSup :: Int
-  , _lb_minNodes   :: Int } deriving (Show) 
+-- | Parameters for SmallBranch filter
+data SBParams = SBParams
+  { _sb_periodsInf :: Int 
+  , _sb_periodsSup :: Int
+  , _sb_minNodes   :: Int } deriving (Show) 
 
 
 ----------------
@@ -321,8 +328,8 @@ data PhyloQuery = PhyloQuery
     , _q_periodGrain :: Int
     , _q_periodSteps :: Int
     
-    -- Clustering method for making level 1 of the Phylo
-    , _q_cluster :: Cluster
+    -- Clustering method for building the contextual unit of Phylo (ie: level 1) 
+    , _q_contextualUnit :: Cluster
     
     -- Inter-temporal matching method of the Phylo
     , _q_interTemporalMatching :: Proximity
@@ -333,7 +340,8 @@ data PhyloQuery = PhyloQuery
     , _q_nthCluster :: Cluster
     } deriving (Show)
 
-data Filiation = Ascendant | Descendant | Complete deriving (Show)
+-- | To choose the Phylo edge you want to export : --> <-- <--> <=>
+data Filiation = Ascendant | Descendant | Merge | Complete deriving (Show)
 data EdgeType  = PeriodEdge | LevelEdge deriving (Show)
 
 
@@ -348,7 +356,7 @@ data PhyloView = PhyloView
   , _phylo_viewTitle       :: Text
   , _phylo_viewDescription :: Text
   , _phylo_viewFiliation   :: Filiation
-  , _phylo_viewMeta        :: Map Text Double
+  , _phylo_viewMetrics     :: Map Text [Double]
   , _phylo_viewBranches    :: [PhyloBranch]
   , _phylo_viewNodes       :: [PhyloNode]
   , _phylo_viewEdges       :: [PhyloEdge]
@@ -358,7 +366,7 @@ data PhyloView = PhyloView
 data PhyloBranch = PhyloBranch 
   { _phylo_branchId      :: PhyloBranchId
   , _phylo_branchLabel   :: Text
-  , _phylo_branchMeta  :: Map Text Double
+  , _phylo_branchMetrics :: Map Text [Double]
   } deriving (Show)  
 
 data PhyloEdge = PhyloEdge
@@ -374,9 +382,9 @@ data PhyloNode = PhyloNode
   , _phylo_nodeLabel     :: Text
   , _phylo_nodeNgramsIdx :: [Int] 
   , _phylo_nodeNgrams    :: Maybe [Ngrams]
-  , _phylo_nodeMeta      :: Map Text Double
-  , _phylo_nodeParent    :: Maybe PhyloGroupId 
-  , _phylo_nodeChilds    :: [PhyloNode]
+  , _phylo_nodeMetrics      :: Map Text [Double]
+  , _phylo_nodeLevelParents :: Maybe [PhyloGroupId] 
+  , _phylo_nodeLevelChilds  :: [PhyloNode]
   } deriving (Show)
 
 
@@ -391,12 +399,12 @@ data DisplayMode = Flat | Nested
 data PhyloQueryView = PhyloQueryView 
   { _qv_lvl    :: Level
 
-  -- Does the PhyloGraph contain ascendant, descendant or a complete Filiation ?
+  -- Does the PhyloGraph contain ascendant, descendant or a complete Filiation ? Complet redondant et merge (avec le max)
   , _qv_filiation :: Filiation
 
   -- Does the PhyloGraph contain some levelChilds ? How deep must it go ?
-  , _qv_childs      :: Bool
-  , _qv_childsDepth :: Level
+  , _qv_levelChilds      :: Bool
+  , _qv_levelChildsDepth :: Level
 
   -- Ordered lists of filters, taggers and metrics to be applied to the PhyloGraph
   -- Firstly the metrics, then the filters and the taggers   

src/Gargantext/Viz/Phylo/Example.hs

@@ -96,7 +96,7 @@ queryViewEx = "level=3"
 
 
 phyloQueryView :: PhyloQueryView
-phyloQueryView = PhyloQueryView 3 Descendant False 1 [BranchAge] [defaultLonelyBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Flat True
+phyloQueryView = PhyloQueryView 3 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Flat True
 
 
 --------------------------------------------------

src/Gargantext/Viz/Phylo/Tools.hs

@@ -438,17 +438,16 @@ getNodeLevel n = (snd . fst) $ getNodeId n
 
 
 -- | To get the Parent Node of a PhyloNode in a PhyloView
-getNodeParent :: PhyloNode -> PhyloView -> PhyloNode
-getNodeParent n v = head 
-                  $ filter (\n' -> getNodeId n' == getNodeParentId n)
+getNodeParent :: PhyloNode -> PhyloView -> [PhyloNode]
+getNodeParent n v = filter (\n' -> elem (getNodeId n') (getNodeParentsId n))
                   $ v ^. phylo_viewNodes
 
 
 -- | To get the Parent Node id of a PhyloNode if it exists
-getNodeParentId :: PhyloNode -> PhyloGroupId
-getNodeParentId n = case n ^. phylo_nodeParent of
-                    Nothing -> panic "[ERR][Viz.Phylo.Tools.getNodeParentId] node parent not found"
-                    Just id -> id
+getNodeParentsId :: PhyloNode -> [PhyloGroupId]
+getNodeParentsId n = case n ^. phylo_nodeLevelParents 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
@@ -496,8 +495,8 @@ getBranchIdsWith lvl p = sortOn snd
 
 
 -- | To get the Meta value of a PhyloBranch 
-getBranchMeta :: Text -> PhyloBranch -> Double 
-getBranchMeta k b = (b ^. phylo_branchMeta) ! k
+getBranchMeta :: Text -> PhyloBranch -> [Double] 
+getBranchMeta k b = (b ^. phylo_branchMetrics) ! k
 
 
 -- | To get all the PhyloBranchIds of a PhyloView
@@ -509,10 +508,9 @@ getViewBranchIds v = map getBranchId $ v ^. phylo_viewBranches
 -- | 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_cluster
+getFstCluster q = q ^. q_contextualUnit
 
 
 -- | To get the cluster methods to apply to the Nths levels of a Phylo
@@ -560,8 +558,8 @@ initFis (def True -> flt) (def True -> kmf) (def 1 -> min) = FisParams flt kmf m
 initHamming :: Maybe Double -> HammingParams
 initHamming (def 0.01 -> sens) = HammingParams sens
 
-initLonelyBranch :: Maybe Int -> Maybe Int -> Maybe Int -> LBParams
-initLonelyBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = LBParams periodsInf periodsSup minNodes
+initSmallBranch :: Maybe Int -> Maybe Int -> Maybe Int -> SBParams
+initSmallBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = SBParams periodsInf periodsSup minNodes
 
 initLouvain :: Maybe Proximity -> LouvainParams
 initLouvain (def defaultWeightedLogJaccard -> proxi) = LouvainParams proxi
@@ -610,8 +608,8 @@ defaultRelatedComponents = RelatedComponents (initRelatedComponents Nothing)
 
 -- Filters
 
-defaultLonelyBranch :: Filter
-defaultLonelyBranch = LonelyBranch (initLonelyBranch Nothing Nothing Nothing)
+defaultSmallBranch :: Filter
+defaultSmallBranch = SmallBranch (initSmallBranch Nothing Nothing Nothing)
 
 -- Params 
 

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

@@ -49,9 +49,9 @@ toNestedView ns ns'
       lvl' = getNodeLevel $ head $ nested
       --------------------------------------
       nested :: [PhyloNode]
-      nested = foldl (\ns' n -> let nId' = getNodeParentId n
-                                in map (\n' -> if getNodeId n' == nId'
-                                               then n' & phylo_nodeChilds %~ (++ [n])
+      nested = foldl (\ns' n -> let nIds' = getNodeParentsId n
+                                in map (\n' -> if elem (getNodeId n') nIds'
+                                               then n' & phylo_nodeLevelChilds %~ (++ [n])
                                                else n') ns') ns' ns
       --------------------------------------  
 

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

@@ -19,7 +19,7 @@ module Gargantext.Viz.Phylo.View.Filters
 
 import Control.Lens     hiding (makeLenses, both, Level)
 
-import Data.List        (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\))
+import Data.List        (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\),intersect)
 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys)
 import Data.Maybe       (isNothing)
 import Data.Set         (Set)
@@ -40,10 +40,10 @@ import qualified Data.Vector as Vector
 -- | To clean a PhyloView list of Nodes, Edges, etc after having filtered its Branches
 cleanNodesEdges :: PhyloView -> PhyloView -> PhyloView
 cleanNodesEdges v v' = v' & phylo_viewNodes %~ (filter (\n -> not $ elem (getNodeId n) nIds))
-                          & phylo_viewNodes %~ (map (\n -> if isNothing (n ^. phylo_nodeParent)
+                          & phylo_viewNodes %~ (map (\n -> if isNothing (n ^. phylo_nodeLevelParents)
                                                            then n
-                                                           else if elem (getNodeParentId n) nIds
-                                                                then n & phylo_nodeParent .~ Nothing
+                                                           else if (not .null) $ (getNodeParentsId n) `intersect` nIds
+                                                                then n & phylo_nodeLevelParents .~ Nothing
                                                                 else n ))
                           & phylo_viewEdges %~ (filter (\e -> (not $ elem (getSourceId e) nIds)
                                                            && (not $ elem (getTargetId e) nIds)))
@@ -59,9 +59,9 @@ cleanNodesEdges v v' = v' & phylo_viewNodes %~ (filter (\n -> not $ elem (getNod
     --------------------------------------
 
 
--- | To filter all the lonelyBranches (ie: isolated one in time & with a small number of nodes) of a PhyloView
-filterLonelyBranch :: Int -> Int -> Int -> [PhyloPeriodId] -> PhyloView -> PhyloView
-filterLonelyBranch inf sup min prds v = cleanNodesEdges v v'
+-- | To filter all the SmallBranches (ie: isolated one in time & with a small number of nodes) of a PhyloView
+filterSmallBranch :: Int -> Int -> Int -> [PhyloPeriodId] -> PhyloView -> PhyloView
+filterSmallBranch inf sup min prds v = cleanNodesEdges v v'
   where
     --------------------------------------
     v' :: PhyloView
@@ -80,6 +80,6 @@ filterLonelyBranch inf sup min prds v = cleanNodesEdges v v'
 -- | To process a list of QueryFilter to a PhyloView
 processFilters :: [Filter] -> Phylo -> PhyloView -> PhyloView
 processFilters fs p v = foldl (\v' f -> case f of
-                                        LonelyBranch (LBParams inf sup min) -> filterLonelyBranch inf sup min 
+                                        SmallBranch (SBParams inf sup min) -> filterSmallBranch inf sup min 
                                                                                (getPhyloPeriods p) v'
                                         _   -> panic "[ERR][Viz.Phylo.View.Filters.processFilters] filter not found") v fs
\ No newline at end of file

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

@@ -38,11 +38,11 @@ import qualified Data.Vector as Vector
 
 
 -- | To add a new meta Metric to a PhyloBranch
-addBranchMeta :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
-addBranchMeta id lbl val v = over (phylo_viewBranches
+addBranchMetrics :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
+addBranchMetrics id lbl val v = over (phylo_viewBranches
                                      . traverse) 
                                     (\b -> if getBranchId b == id
-                                         then b & phylo_branchMeta %~ insert lbl val 
+                                           then b & phylo_branchMetrics %~ insert lbl [val] 
                                            else b) v
 
 
@@ -50,8 +50,7 @@ addBranchMeta id lbl val v = over (phylo_viewBranches
 branchAge :: PhyloView -> PhyloView
 branchAge v = foldl (\v' b -> let bId = (fst . head) b
                                   prds = sortOn fst $ map snd b
-                              in addBranchMeta bId "age" ((abs . fromIntegral) 
-                                                          $ ((snd . last) prds) - ((fst . head) prds)) v') v
+                              in addBranchMetrics bId "age" ((abs . fromIntegral) $ ((snd . last) prds) - ((fst . head) prds)) v') v
             $ groupBy ((==) `on` fst)
             $ sortOn fst
             $ map (\n -> (getNodeBranchId n, (fst . fst) $ getNodeId n))

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

@@ -20,7 +20,7 @@ module Gargantext.Viz.Phylo.View.ViewMaker
 import Control.Lens     hiding (makeLenses, both, Level)
 
 import Data.List        (notElem,last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!),sortOn,sort,(\\))
-import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys,insert,empty)
+import Data.Map         (Map,elems,adjust,unionWith,unionWithKey,intersectionWith,fromList,mapKeys,insert,empty)
 import Data.Maybe       (isNothing)
 import Data.Set         (Set)
 import Data.Text        (Text,unwords)
@@ -77,16 +77,32 @@ groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
                                                 else Nothing)
                                               empty 
                                               (if (not isR)
-                                                then Just (head $ getGroupLevelParentsId g)
+                                                then Just (getGroupLevelParentsId g)
                                                 else Nothing)
                                               []
                                   ) gs
 
 
+mergeEdges :: [PhyloEdge] -> [PhyloEdge] -> [PhyloEdge]
+mergeEdges lAsc lDes = elems 
+                     $ unionWithKey (\k vAsc vDes -> vDes & phylo_edgeWeight .~ (max (vAsc ^. phylo_edgeWeight) (vDes ^. phylo_edgeWeight))) mAsc mDes
+  where
+    --------------------------------------
+    mAsc :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
+    mAsc = fromList 
+         $ zip (map (\e -> (e ^. phylo_edgeTarget,e ^. phylo_edgeSource)) lAsc) lAsc
+    --------------------------------------
+    mDes :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
+    mDes = fromList 
+         $ zip (map (\e -> (e ^. phylo_edgeSource,e ^. phylo_edgeTarget)) lDes) lDes
+    --------------------------------------
+
+
 -- | To transform a list of PhyloGroups into a list of PhyloEdges
 groupsToEdges :: Filiation -> EdgeType -> [PhyloGroup] -> [PhyloEdge]
 groupsToEdges fl et gs = case fl of 
                          Complete -> (groupsToEdges Ascendant et gs) ++ (groupsToEdges Descendant et gs)
+                         Merge    -> mergeEdges (groupsToEdges Ascendant et gs) (groupsToEdges Descendant et gs)
                          _        -> concat 
                                    $ map (\g -> case fl of
                                                 Ascendant  -> case et of 
@@ -131,7 +147,7 @@ toPhyloView q p = processDisplay (q ^. qv_display)
                 $ processTaggers (q ^. qv_taggers) p
                 $ processFilters (q ^. qv_filters) p
                 $ processMetrics (q ^. qv_metrics) p 
-                $ addChildNodes  (q ^. qv_childs) (q ^. qv_lvl) (q ^. qv_childsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
+                $ addChildNodes  (q ^. qv_levelChilds) (q ^. qv_lvl) (q ^. qv_levelChildsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
                 $ initPhyloView  (q ^. qv_lvl) (getPhyloTitle p) (getPhyloDescription p) (q ^. qv_filiation) (q ^. qv_verbose) p