Merge branch 'dev-phylo' of...

Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-phylo

bin/gargantext-adaptative-phylo/Main.hs

@@ -172,12 +172,23 @@ main = do
                         Hamming -> undefined
                         WeightedLogJaccard s -> (show s)    
 
+            let sync = case (phyloSynchrony config) of
+                        ByProximityThreshold t _ _ _ -> (show t)
+                        ByProximityDistribution _ _ -> undefined
+
+            -- to be improved
+            -- let br_length = case (take 1 $ exportFilter config) of
+            --             ByBranchSize t -> (show t)
+                        
+
             let output = (outputPath config) 
                       <> (unpack $ phyloName config)
-                      <> "-scale_" <> (show (_qua_granularity $ phyloQuality config))
-                      <> "-level_" <> (show (phyloLevel config))
                       <> "-" <> clq
+                      <> "-level_" <> (show (phyloLevel config))
                       <> "-sens_" <> sensibility                      
+                      -- <> "-lenght_" <> br_length                                            
+                      <> "-scale_" <> (show (_qua_granularity $ phyloQuality config))
+                      <> "-sync_" <> sync                                                                  
                       <> ".dot"
 
             dotToFile output dot

src/Gargantext/Core/Viz/Phylo/PhyloExport.hs

@@ -142,6 +142,7 @@ groupToDotNode fdt g bId =
                          , toAttr "lbl" (pack $ show (ngramsToLabel fdt (g ^. phylo_groupNgrams)))
                          , toAttr "foundation" (pack $ show (idxToLabel (g ^. phylo_groupNgrams)))
                          , toAttr "role" (pack $ show (idxToLabel' ((g ^. phylo_groupMeta) ! "dynamics")))
+                         , toAttr "frequence" (pack $ show (idxToLabel' ((g ^. phylo_groupMeta) ! "frequence")))
                          ])  
 
 
@@ -192,7 +193,7 @@ exportToDot phylo export =
                      ,(toAttr (fromStrict "phyloPeriods") $ pack $ show (length $ elems $ phylo ^. phylo_periods))
                      ,(toAttr (fromStrict "phyloBranches") $ pack $ show (length $ export ^. export_branches))
                      ,(toAttr (fromStrict "phyloGroups") $ pack $ show (length $ export ^. export_groups))
-                     ,(toAttr (fromStrict "phyloTermsFreq") $ pack $ show (toList $ _phylo_lastTermFreq phylo))
+                     -- ,(toAttr (fromStrict "phyloTermsFreq") $ pack $ show (toList $ _phylo_lastTermFreq phylo))
                      ])
 
 {-
@@ -201,7 +202,7 @@ exportToDot phylo export =
         --  2) create a layer for the branches labels -}
         subgraph (Str "Branches peaks") $ do 
 
-            graphAttrs [Rank SameRank]
+            -- graphAttrs [Rank SameRank]
 {-
             --  3) group the branches by hierarchy
             -- mapM (\branches -> 
@@ -368,8 +369,8 @@ inclusion m l i = ( (sum $ map (\j -> conditional m j i) l)
                   + (sum $ map (\j -> conditional m i j) l)) / (fromIntegral $ (length l) + 1)
 
 
-ngramsMetrics :: PhyloExport -> PhyloExport
-ngramsMetrics export =
+ngramsMetrics :: Phylo -> PhyloExport -> PhyloExport
+ngramsMetrics phylo export =
     over ( export_groups
          .  traverse )
     (\g -> g & phylo_groupMeta %~ insert "genericity" 
@@ -378,6 +379,8 @@ ngramsMetrics export =
                                   (map (\n -> specificity (g ^. phylo_groupCooc) ((g ^. phylo_groupNgrams) \\ [n]) n) $ g ^. phylo_groupNgrams)
              & phylo_groupMeta %~ insert "inclusion" 
                                   (map (\n -> inclusion   (g ^. phylo_groupCooc) ((g ^. phylo_groupNgrams) \\ [n]) n) $ g ^. phylo_groupNgrams)
+             & phylo_groupMeta %~ insert "frequence" 
+                                  (map (\n -> getInMap n (phylo ^. phylo_lastTermFreq)) $ g ^. phylo_groupNgrams)                                  
         ) export
 
 
@@ -397,8 +400,8 @@ branchDating export =
              & branch_meta %~ insert "age"   [fromIntegral age]
              & branch_meta %~ insert "size"  [fromIntegral $ length periods] ) export
 
-processMetrics :: PhyloExport -> PhyloExport
-processMetrics export = ngramsMetrics
+processMetrics :: Phylo -> PhyloExport -> PhyloExport
+processMetrics phylo export = ngramsMetrics phylo
                             $ branchDating export 
 
 
@@ -630,7 +633,7 @@ toPhyloExport phylo = exportToDot phylo
                     $ processFilters (exportFilter $ getConfig phylo) (phyloQuality $ getConfig phylo)
                     $ processSort    (exportSort   $ getConfig phylo) (getSeaElevation phylo)
                     $ processLabels  (exportLabel  $ getConfig phylo) (getRoots phylo) (_phylo_lastTermFreq phylo)
-                    $ processMetrics  export           
+                    $ processMetrics phylo export           
     where
         export :: PhyloExport
         export = PhyloExport groups branches     

src/Gargantext/Core/Viz/Phylo/PhyloTools.hs

@@ -69,6 +69,12 @@ truncate' x n = (fromIntegral $ (floor (x * t) :: Int)) / t
         t :: Double
         t = 10 ^n
 
+getInMap :: Int -> Map Int Double -> Double
+getInMap k m = 
+    if (member k m)
+        then m ! k
+        else 0
+
 roundToStr :: (PrintfArg a, Floating a) => Int -> a -> String
 roundToStr = printf "%0.*f"