add branch w and t

src/Gargantext/Viz/AdaptativePhylo.hs

@@ -144,9 +144,9 @@ defaultConfig =
             , phyloName      = pack "Default Phylo"
             , phyloLevel     = 2
             , phyloProximity = WeightedLogJaccard 10
-            , seaElevation   = Adaptative 25
-            , phyloSynchrony = ByProximityThreshold 0.6 10 SiblingBranches MergeAllGroups
-            , phyloQuality   = Quality 0.1 1
+            , seaElevation   = Constante 0 0.1
+            , phyloSynchrony = ByProximityThreshold 0.5 10 SiblingBranches MergeAllGroups
+            , phyloQuality   = Quality 0.6 1
             , timeUnit       = Year 3 1 5
             , clique         = Fis 1 5
             , exportLabel    = [BranchLabel MostInclusive 2, GroupLabel MostEmergentInclusive 2]
@@ -385,6 +385,8 @@ data PhyloBranch =
       , _branch_seaLevel :: [Double]
       , _branch_x        :: Double
       , _branch_y        :: Double
+      , _branch_w        :: Double
+      , _branch_t        :: Double
       , _branch_label    :: Text
       , _branch_meta     :: Map Text [Double]
       } deriving (Generic, Show, Eq)

src/Gargantext/Viz/Phylo/PhyloExport.hs

@@ -18,10 +18,10 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.PhyloExport where
 
 import Data.Map (Map, fromList, empty, fromListWith, insert, (!), elems, unionWith, findWithDefault, toList)
-import Data.List ((++), sort, nub, concat, sortOn, reverse, groupBy, union, (\\), (!!), init, partition, unwords, nubBy, inits)
+import Data.List ((++), sort, nub, concat, sortOn, reverse, groupBy, union, (\\), (!!), init, partition, unwords, nubBy, inits, tail)
 import Data.Vector (Vector)
 
-import Prelude (writeFile)
+import Prelude (writeFile, replicate)
 import Gargantext.Prelude
 import Gargantext.Viz.AdaptativePhylo
 import Gargantext.Viz.Phylo.PhyloTools 
@@ -469,6 +469,23 @@ toPhyloExport phylo = exportToDot phylo
     where
         export :: PhyloExport
         export = PhyloExport groups 
+               $ map (\((w,t),b) -> b & branch_w .~ w
+                                      & branch_t .~ t)
+               $ zip toScale branches'
+        --------------------------------------
+        toScale :: [(Double,Double)]
+        toScale = 
+          let ws  = map (\b -> 5 * (2 * (b ^. branch_w) - 1)) branches' 
+              ts  = map (/2) ws
+              ts' = map (\(x,y) -> x + y)
+                  $ zip ts
+                  $ map (\(x,y) -> x + y)
+                  $ zip (map sum $ tail $ inits $ replicate (length ws) 10)
+                  $ map sum $ init $ inits ws
+           in zip ws ts'
+        --------------------------------------
+        branches' :: [PhyloBranch]
+        branches' = sortOn _branch_x
                   $ map (\(x,b) -> b & branch_x .~ x)
                   $ zip branchesGaps branches
         --------------------------------------
@@ -482,8 +499,14 @@ toPhyloExport phylo = exportToDot phylo
                                          in (b' ^. branch_seaLevel) !! (idx - 1)
                                         ) $ listToSeq branches))
         --------------------------------------     
+        toWidth :: [PhyloGroup] -> Double
+        toWidth gs = fromIntegral 
+                   $ maximum
+                   $ map length
+                   $ groupBy (\g g' -> g ^. phylo_groupPeriod == g' ^. phylo_groupPeriod) gs        
+        --------------------------------------
         branches :: [PhyloBranch]
-        branches = map (\g -> 
+        branches = map (\(g,w) -> 
                       let seaLvl = (g ^. phylo_groupMeta) ! "seaLevels"
                           breaks = (g ^. phylo_groupMeta) ! "breaks"
                           canonId = take (round $ (last' "export" breaks) + 2) (snd $ g ^. phylo_groupBranchId)
@@ -492,8 +515,10 @@ toPhyloExport phylo = exportToDot phylo
                                       seaLvl
                                       0 
                                       (last' "export" (take (round $ (last' "export" breaks) + 1) seaLvl))
+                                      w
+                                      0
                                       "" empty)  
-                  $ map (\gs -> head' "export" gs)
+                  $ map (\gs -> (head' "export" gs,toWidth gs))
                   $ groupBy (\g g' -> g ^. phylo_groupBranchId == g' ^. phylo_groupBranchId)
                   $ sortOn (\g -> g ^. phylo_groupBranchId) groups
         --------------------------------------    

src/Gargantext/Viz/Phylo/PhyloMaker.hs

@@ -15,7 +15,7 @@ Portability : POSIX
 
 module Gargantext.Viz.Phylo.PhyloMaker where
 
-import Data.List (concat, nub, partition, sort, (++), group, intersect, null)
+import Data.List (concat, nub, partition, sort, (++), group, intersect, null, sortOn, groupBy)
 import Data.Map (Map, fromListWith, keys, unionWith, fromList, empty, toList, elems, (!), restrictKeys, foldlWithKey)
 import Data.Set (size)
 import Data.Vector (Vector)
@@ -127,7 +127,6 @@ cliqueToGroup fis pId lvl idx fdt coocs =
 toPhylo1 :: [Document] -> Phylo -> Phylo
 toPhylo1 docs phyloBase = case (getSeaElevation phyloBase) of 
     Constante start gap -> constanteTemporalMatching  start gap 
-                   $ toGroupsProxi 1
                    $ appendGroups cliqueToGroup 1 phyloClique phyloBase    
     Adaptative steps    -> adaptativeTemporalMatching steps
                    $ toGroupsProxi 1
@@ -138,7 +137,7 @@ toPhylo1 docs phyloBase = case (getSeaElevation phyloBase) of
         phyloClique =  toPhyloClique phyloBase docs'
         --------------------------------------
         docs' :: Map (Date,Date) [Document]
-        docs' =  groupDocsByPeriod date (getPeriodIds phyloBase) docs
+        docs' =  groupDocsByPeriod' date (getPeriodIds phyloBase) docs
         --------------------------------------
 
 
@@ -226,6 +225,21 @@ docsToTimeScaleCooc docs fdt =
 -- | to Phylo Base | --
 -----------------------
 
+-- | To group a list of Documents by fixed periods
+groupDocsByPeriod' :: (NFData doc, Ord date, Enum date) => (doc -> date) -> [(date,date)] -> [doc] -> Map (date, date) [doc]
+groupDocsByPeriod' f pds docs = 
+  let docs'    = groupBy (\d d' -> f d == f d') $ sortOn f docs
+      periods  = map (inPeriode f docs') pds
+      periods' = periods `using` parList rdeepseq
+   in trace ("\n" <> "-- | Group " <> show(length docs) <> " docs by " <> show(length pds) <> " periods" <> "\n") 
+    $ fromList $ zip pds periods'
+  where
+    --------------------------------------
+    inPeriode :: Ord b => (t -> b) -> [[t]] -> (b, b) -> [t]
+    inPeriode f' h (start,end) =
+      concat $ fst $ partition (\d -> f' (head' "inPeriode" d) >= start && f' (head' "inPeriode" d) <= end) h
+
+
 
 -- | To group a list of Documents by fixed periods
 groupDocsByPeriod :: (NFData doc, Ord date, Enum date) => (doc -> date) -> [(date,date)] -> [doc] -> Map (date, date) [doc]

src/Gargantext/Viz/Phylo/TemporalMatching.hs

@@ -380,8 +380,8 @@ constanteTemporalMatching start step phylo = updatePhyloGroups 1
                                 (_qua_minBranch $ phyloQuality $ getConfig phylo)
                                 (phylo ^. phylo_termFreq)
                                 start step
-                                (fromIntegral $ round (((1 - start) / step) - 1))
-                                (fromIntegral $ round ((1 - start) / step))
+                                ((((1 - start) / step) - 1))
+                                (((1 - start) / step))
                                 (getTimeFrame $ timeUnit $ getConfig phylo)
                                 (getPeriodIds phylo)
                                 (phylo ^. phylo_timeDocs)