some addings linked to the memiescape

bin/gargantext-phylo/Main.hs

@@ -216,7 +216,7 @@ main = do
                   (reBranchThr conf) (reBranchNth conf) (phyloLevel conf)
                   (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams (clusterTh conf) (clusterSens conf))
 
-      let queryView = PhyloQueryView (viewLevel conf) Merge False 1 [BranchAge,BranchBirth] [SizeBranch $ SBParams (minSizeBranch conf)] [GroupLabelIncDyn,BranchPeakInc] (Just (ByBranchBirth,Asc)) Json Flat True           
+      let queryView = PhyloQueryView (viewLevel conf) Merge False 1 [BranchAge,BranchBirth,BranchGroups] [SizeBranch $ SBParams (minSizeBranch conf)] [GroupLabelIncDyn,BranchPeakInc] (Just (ByBranchBirth,Asc)) Json Flat True           
 
       let phylo = toPhylo query corpus termList fis'
 

src/Gargantext/Viz/Phylo.hs

@@ -309,7 +309,7 @@ data SBParams = SBParams
 
 
 -- | Metric constructors
-data Metric = BranchAge | BranchBirth deriving (Generic, Show, Eq, Read)
+data Metric = BranchAge | BranchBirth | BranchGroups deriving (Generic, Show, Eq, Read)
 
 
 ----------------

src/Gargantext/Viz/Phylo/Example.hs

@@ -83,7 +83,7 @@ queryViewEx = "level=3"
 
 
 phyloQueryView :: PhyloQueryView
-phyloQueryView = PhyloQueryView 2 Merge False 2 [BranchAge,BranchBirth] [] [BranchPeakInc,GroupLabelIncDyn] (Just (ByBranchBirth,Asc)) Json Flat True
+phyloQueryView = PhyloQueryView 2 Merge False 2 [BranchAge,BranchBirth,BranchGroups] [] [BranchPeakInc,GroupLabelIncDyn] (Just (ByBranchBirth,Asc)) Json Flat True
 
 
 --------------------------------------------------

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

@@ -124,7 +124,8 @@ toDotLabel lbl = StrLabel $ fromStrict lbl
 setPeakDotNode :: PhyloBranch -> Dot DotId
 setPeakDotNode pb = node (toBranchDotId $ pb ^. pb_id) 
                       ([FillColor [toWColor CornSilk], FontName "Arial", FontSize 40, Shape Egg, Style [SItem Bold []], Label (toDotLabel $ pb ^. pb_peak)]
-                       <> (setAttrFromMetrics $ pb ^. pb_metrics))
+                       <> (setAttrFromMetrics $ pb ^. pb_metrics)
+                       <> [setAttr "nodeType" "peak"])
 
 
 -- | To set a Peak Edge
@@ -186,7 +187,8 @@ setHtmlTable pn = H.Table H.HTable
 -- | To set a Node
 setDotNode :: PhyloNode -> Dot DotId
 setDotNode pn = node (toNodeDotId $ pn ^. pn_id)
-                     ([FontName "Arial", Shape Square, toLabel (setHtmlTable pn)])
+                     ([FontName "Arial", Shape Square, toLabel (setHtmlTable pn)]
+                      <> [setAttr "nodeType" "group"])
 
 
 -- | To set an Edge
@@ -235,7 +237,10 @@ viewToDot pv = digraph ((Str . fromStrict) $ pv ^. pv_title)
 
                             -- set the period label
                             
-                            node (toPeriodDotId prd) [Shape Square, FontSize 50, Label (toPeriodDotLabel prd)]
+                            node (toPeriodDotId prd) ([Shape Square, FontSize 50, Label (toPeriodDotLabel prd)] 
+                                                   <> [setAttr "nodeType" "period", 
+                                                       setAttr "from" (fromStrict $ T.pack $ (show $ fst prd)),
+                                                       setAttr "to"   (fromStrict $ T.pack $ (show $ snd prd))])
 
                             mapM setDotNode $ filterNodesByPeriod prd $ filterNodesByLevel (pv ^. pv_level) (pv ^.pv_nodes)
                           

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

@@ -36,6 +36,12 @@ addBranchMetrics id lbl val v = over (pv_branches
                                            else b) v
 
 
+branchGroups :: PhyloView -> PhyloView
+branchGroups v = foldl (\v' (bId,nb) -> addBranchMetrics bId "nbGroups" nb v') v
+               $ map (\(bId,ns) -> (bId,fromIntegral $ length ns)) 
+               $ getNodesByBranches v
+
+
 -- | To get the age (in year) of all the branches of a PhyloView
 branchAge :: PhyloView -> PhyloView
 branchAge v = foldl (\v' b -> let bId = (fst . (head' "branchAge")) b
@@ -63,6 +69,7 @@ processMetrics :: [Metric] -> Phylo -> PhyloView -> PhyloView
 processMetrics ms _p v = foldl (\v' m -> case m of
                                         BranchAge -> branchAge v'
                                         BranchBirth -> branchBirth v'
+                                        BranchGroups -> branchGroups v'
                                        -- _         -> panic "[ERR][Viz.Phylo.Example.processMetrics] metric not found"
                                         ) v ms