changes done

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

@@ -146,13 +146,26 @@ groupToDotNode fdt g bId =
                          , 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")))
+                         , toAttr "seaLvl" (pack $ show ((g ^. phylo_groupMeta) ! "seaLevels"))
                          ])  
 
 
+toDotEdge' :: DotId -> DotId -> [Char] -> [Char] -> EdgeType -> Dot DotId
+toDotEdge' source target thr w edgeType = edge source target
+    (case edgeType of
+        GroupToGroup    -> undefined
+        GroupToGroupMemory  -> [ Width 3, penWidth 4, Color [toWColor Black], Constraint True] <> [toAttr "edgeType" "memoryLink", toAttr "thr" (pack thr), toAttr "weight" (pack w)]
+        BranchToGroup   -> undefined
+        BranchToBranch  -> undefined
+        GroupToAncestor -> undefined
+        PeriodToPeriod  -> undefined)
+
+
 toDotEdge :: DotId -> DotId -> [Char] -> EdgeType -> Dot DotId
 toDotEdge source target lbl edgeType = edge source target
     (case edgeType of
         GroupToGroup    -> [ Width 3, penWidth 4, Color [toWColor Black], Constraint True] <> [toAttr "edgeType" "link", toAttr "lbl" (pack lbl)]
+        GroupToGroupMemory  -> undefined
         BranchToGroup   -> [ Width 3, Color [toWColor Black], ArrowHead (AType [(ArrMod FilledArrow RightSide,DotArrow)])] <> [toAttr "edgeType" "branchLink" ]
         BranchToBranch  -> [ Width 2, Color [toWColor Black], Style [SItem Dashed []], ArrowHead (AType [(ArrMod FilledArrow BothSides,DotArrow)])]
         GroupToAncestor -> [ Width 3, Color [toWColor Red], Style [SItem Dashed []], ArrowHead (AType [(ArrMod FilledArrow BothSides,NoArrow)]), PenWidth 4] <> [toAttr "edgeType" "ancestorLink", toAttr "lbl" (pack lbl)]                          
@@ -165,6 +178,12 @@ mergePointers groups =
         toParents = fromList $ concat $ map (\g -> map (\(target,w) -> ((target,getGroupId g),w)) $ g ^. phylo_groupPeriodParents) groups
     in  unionWith (\w w' -> max w w') toChilds toParents
 
+mergePointersMemory :: [PhyloGroup] -> [((PhyloGroupId,PhyloGroupId),(Double,Double))]
+mergePointersMemory groups =
+    let toChilds  = concat $ map (\g -> map (\(target,(t,w)) -> ((getGroupId g,target),(t,w))) $ g ^. phylo_groupPeriodMemoryChilds) groups
+        toParents = concat $ map (\g -> map (\(target,(t,w)) -> ((target,getGroupId g),(t,w))) $ g ^. phylo_groupPeriodMemoryParents) groups
+    in  concat [toChilds,toParents]
+
 mergeAncestors :: [PhyloGroup] -> [((PhyloGroupId,PhyloGroupId), Double)]
 mergeAncestors groups = concat
                       $ map (\g -> map (\(target,w) -> ((getGroupId g,target),w)) $ g ^. phylo_groupAncestors) 
@@ -245,6 +264,11 @@ exportToDot phylo export =
                 toDotEdge (groupIdToDotId k) (groupIdToDotId k') (show v) GroupToGroup
             ) $ (toList . mergePointers) $ export ^. export_groups
 
+        {-  8-bis) create the edges between the groups -}
+        _ <- mapM (\((k,k'),v) ->
+                toDotEdge' (groupIdToDotId k) (groupIdToDotId k') (show (fst v)) (show (snd v)) GroupToGroupMemory
+            ) $ mergePointersMemory $ export ^. export_groups
+
         _ <- mapM (\((k,k'),v) -> 
                 toDotEdge (groupIdToDotId k) (groupIdToDotId k') (show v) GroupToAncestor
           ) $ mergeAncestors $ export ^. export_groups

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

@@ -135,7 +135,7 @@ cliqueToGroup fis pId pId' lvl idx coocs = PhyloGroup pId pId' lvl idx ""
                    (ngramsToCooc (fis ^. phyloClique_nodes) coocs)
                    (1,[0]) -- branchid (lvl,[path in the branching tree])
                    (fromList [("breaks",[0]),("seaLevels",[0])])
-                   [] [] [] [] []
+                   [] [] [] [] [] [] []
 
 
 toPhylo1 :: Phylo -> Phylo

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

@@ -45,6 +45,8 @@ mergeGroups coocs id mapIds childs =
                   (updatePointers $ concat $ map _phylo_groupPeriodParents childs)
                   (updatePointers $ concat $ map _phylo_groupPeriodChilds  childs)
                   (mergeAncestors $ concat $ map _phylo_groupAncestors childs)
+                  (updatePointers' $ concat $ map _phylo_groupPeriodMemoryParents childs)
+                  (updatePointers' $ concat $ map _phylo_groupPeriodMemoryChilds  childs)
     where
         --------------------
         bId :: [Int]
@@ -52,6 +54,8 @@ mergeGroups coocs id mapIds childs =
         --------------------
         updatePointers :: [Pointer] -> [Pointer]
         updatePointers pointers = map (\(pId,w) -> (mapIds ! pId,w)) pointers
+        updatePointers' :: [Pointer'] -> [Pointer']
+        updatePointers' pointers = map (\(pId,(t,w)) -> (mapIds ! pId,(t,w))) pointers
         --------------------
         mergeAncestors :: [Pointer] -> [Pointer]
         mergeAncestors pointers = Map.toList $ fromListWith max pointers

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

@@ -119,6 +119,8 @@ findLastPeriod :: Filiation -> [PhyloPeriodId] -> PhyloPeriodId
 findLastPeriod fil periods = case fil of
     ToParents -> head' "findLastPeriod" (sortOn fst periods)
     ToChilds  -> last' "findLastPeriod" (sortOn fst periods)
+    ToChildsMemory  -> undefined
+    ToParentsMemory -> undefined
 
 
 -- | To filter pairs of candidates related to old pointers periods
@@ -133,10 +135,12 @@ removeOldPointers oldPointers fil thr prox prd pairs
         then []
         else filter (\((id,_),(id',_)) -> 
                 case fil of
+                     ToChildsMemory  -> undefined
+                     ToParentsMemory -> undefined
                      ToParents -> (((fst . fst . fst) id ) < (fst lastMatchedPrd))
                                || (((fst . fst . fst) id') < (fst lastMatchedPrd))
                      ToChilds  -> (((fst . fst . fst) id ) > (fst lastMatchedPrd))
-                               || (((fst . fst . fst) id') > (fst lastMatchedPrd))) pairs 
+                               || (((fst . fst . fst) id') > (fst lastMatchedPrd))) pairs
   | otherwise = []
 
 
@@ -181,6 +185,8 @@ filterPointersByPeriod fil pts =
     $ case fil of
         ToParents -> reverse pts'
         ToChilds  -> pts'
+        ToChildsMemory  -> undefined
+        ToParentsMemory -> undefined
 
 phyloGroupMatching :: [[(PhyloGroupId,[Int])]] -> Filiation -> Proximity -> Map Date Double -> Map Date Cooc
                    -> Double -> [Pointer] -> (PhyloGroupId,[Int]) -> [Pointer]
@@ -236,6 +242,8 @@ getNextPeriods fil max' pId pIds =
     case fil of 
         ToChilds  -> take max' $ (tail . snd) $ splitAt (elemIndex' pId pIds) pIds
         ToParents -> take max' $ (reverse . fst) $ splitAt (elemIndex' pId pIds) pIds
+        ToChildsMemory  -> undefined
+        ToParentsMemory -> undefined
 
 
 getCandidates :: PhyloGroup -> [[(PhyloGroupId,[Int])]] -> [[(PhyloGroupId,[Int])]]
@@ -268,7 +276,9 @@ matchGroupsToGroups frame periods proximity thr docs coocs groups =
                           pointersChi = phyloGroupMatching (getCandidates ego candidatesChi) ToChilds  proximity docsChi diagoChi
                                         thr (getPeriodPointers ToChilds  ego) (getGroupId ego, ego ^. phylo_groupNgrams)
                        in addPointers ToChilds  TemporalPointer pointersChi
-                        $ addPointers ToParents TemporalPointer pointersPar ego)
+                        $ addPointers ToParents TemporalPointer pointersPar
+                        $ addMemoryPointers ToChildsMemory  TemporalPointer thr pointersChi
+                        $ addMemoryPointers ToParentsMemory TemporalPointer thr pointersPar ego)
                   $ findWithDefault [] prd groups'
             egos' = egos `using` parList rdeepseq 
          in acc ++ egos'