optimisation for temporal matching

src/Gargantext/Viz/AdaptativePhylo.hs

@@ -88,7 +88,13 @@ data ContextualUnit =
       Fis 
       { _fis_support :: Int
       , _fis_size    :: Int }
-      deriving (Show,Generic,Eq)       
+      deriving (Show,Generic,Eq)      
+
+
+data Quality = 
+     Quality { _qua_relevance :: Double
+             , _qua_minBranch :: Int }
+      deriving (Show,Generic,Eq)   
 
 
 data Config = 
@@ -100,6 +106,7 @@ data Config =
             , phyloLevel     :: Int
             , phyloProximity :: Proximity
             , phyloSynchrony :: Synchrony
+            , phyloQuality   :: Quality
             , timeUnit       :: TimeUnit
             , contextualUnit :: ContextualUnit
             , exportLabel    :: [PhyloLabel]
@@ -118,8 +125,9 @@ defaultConfig =
             , phyloLevel     = 1
             , phyloProximity = WeightedLogJaccard 10 0 0.1
             , phyloSynchrony = ByProximityDistribution 0
+            , phyloQuality   = Quality 1 1
             , timeUnit       = Year 3 1 5
-            , contextualUnit = Fis 2 4
+            , contextualUnit = Fis 1 4
             , exportLabel    = [BranchLabel MostInclusive 2, GroupLabel MostEmergentInclusive 2]
             , exportSort     = ByHierarchy
             , exportFilter   = [ByBranchSize 2]  
@@ -147,6 +155,8 @@ instance FromJSON Filter
 instance ToJSON Filter
 instance FromJSON Synchrony
 instance ToJSON Synchrony
+instance FromJSON Quality
+instance ToJSON Quality
 
 
 -- | Software parameters
@@ -362,6 +372,7 @@ data PhyloExport =
 
 makeLenses ''Config
 makeLenses ''Proximity
+makeLenses ''Quality
 makeLenses ''ContextualUnit
 makeLenses ''PhyloLabel
 makeLenses ''TimeUnit

src/Gargantext/Viz/Phylo/Example.hs

@@ -83,7 +83,7 @@ queryViewEx = "level=3"
 
 
 phyloQueryView :: PhyloQueryView
-phyloQueryView = PhyloQueryView 2 Merge False 2 [BranchAge,BranchBirth,BranchGroups] [] [BranchPeakInc,GroupLabelIncDyn] (Just (ByBranchBirth,Asc)) Json Flat True
+phyloQueryView = PhyloQueryView 1 Merge False 1 [BranchAge,BranchBirth,BranchGroups] [] [BranchPeakInc,GroupLabelIncDyn] (Just (ByBranchBirth,Asc)) Json Flat True
 
 
 --------------------------------------------------
@@ -110,7 +110,7 @@ queryEx = "title=Cesar et Cleôpatre"
 
 phyloQueryBuild :: PhyloQueryBuild
 phyloQueryBuild = PhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
-             3 1 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.5 20) 5 0.8 0.5 4 2 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.3 0) 
+             3 1 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.9 10) 5 0.8 0.5 4 1 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.3 0) 
 
 
 

src/Gargantext/Viz/Phylo/PhyloExport.hs

@@ -156,6 +156,8 @@ mergePointers groups =
 
 exportToDot :: Phylo -> PhyloExport -> DotGraph DotId
 exportToDot phylo export = 
+    trace ("\n-- | Convert " <> show(length $ export ^. export_branches) <> " branches and "
+         <> show(length $ export ^. export_groups) <> " groups to a dot file\n") $
     digraph ((Str . fromStrict) $ (phyloName $ getConfig phylo)) $ do 
 
         -- | 1) init the dot graph
@@ -238,10 +240,12 @@ filterByBranchSize thr export =
                & export_groups %~ (filter (\g -> not $ elem  (g ^. phylo_groupBranchId) (map _branch_id $ snd branches')))
 
 
-processFilters :: [Filter] -> PhyloExport -> PhyloExport
-processFilters filters export = 
+processFilters :: [Filter] -> Quality -> PhyloExport -> PhyloExport
+processFilters filters qua export = 
     foldl (\export' f -> case f of 
-                ByBranchSize thr -> filterByBranchSize thr export'
+                ByBranchSize thr -> if (thr < (fromIntegral $ qua ^. qua_minBranch))
+                                      then filterByBranchSize (fromIntegral $ qua ^. qua_minBranch) export'
+                                      else filterByBranchSize thr export'  
         ) export filters
 
 --------------
@@ -439,7 +443,7 @@ processDynamics groups =
 
 toPhyloExport :: Phylo -> DotGraph DotId
 toPhyloExport phylo = exportToDot phylo
-                    $ processFilters (exportFilter $ getConfig phylo)
+                    $ processFilters (exportFilter $ getConfig phylo) (phyloQuality $ getConfig phylo)
                     $ processSort    (exportSort   $ getConfig phylo)
                     $ processLabels  (exportLabel  $ getConfig phylo) (getRoots phylo)
                     $ processMetrics  export           

src/Gargantext/Viz/Phylo/Tools.hs

@@ -815,7 +815,7 @@ getProximity cluster = case cluster of
 
 -- | To initialize all the Cluster / Proximity with their default parameters
 initFis :: Maybe Bool -> Maybe Support -> Maybe Int -> FisParams
-initFis (def True -> kmf) (def 2 -> min') (def 4 -> thr) = FisParams kmf min' thr
+initFis (def True -> kmf) (def 0 -> min') (def 0 -> thr) = FisParams kmf min' thr
 
 initHamming :: Maybe Double -> HammingParams
 initHamming (def 0.01 -> sens) = HammingParams sens