filter the clique by neighbours

bin/gargantext-adaptative-phylo/Main.hs

@@ -166,7 +166,7 @@ main = do
 
             let clq = case (clique config) of
                         Fis s s' -> "fis_" <> (show s) <> "_" <> (show s')
-                        MaxClique s ->  "clique_" <> (show s)
+                        MaxClique s _ _ ->  "clique_" <> (show s)
 
             let sensibility = case (phyloProximity config) of
                         Hamming -> undefined

src/Gargantext/Core/Viz/AdaptativePhylo.hs

@@ -99,13 +99,16 @@ data TimeUnit =
       , _year_matchingFrame :: Int }
       deriving (Show,Generic,Eq) 
 
+data CliqueFilter = ByThreshold | ByNeighbours deriving (Show,Generic,Eq)
 
 data Clique = 
       Fis 
       { _fis_support :: Int
       , _fis_size    :: Int }
     | MaxClique
-      { _mcl_size :: Int } 
+      { _mcl_size      :: Int
+      , _mcl_threshold :: Double
+      , _mcl_filter    :: CliqueFilter } 
       deriving (Show,Generic,Eq)      
 
 
@@ -149,7 +152,7 @@ defaultConfig =
             , phyloSynchrony = ByProximityThreshold 0.1 10 SiblingBranches MergeAllGroups
             , phyloQuality   = Quality 0 1
             , timeUnit       = Year 3 1 5
-            , clique         = MaxClique 0
+            , clique         = MaxClique 0 3 ByNeighbours
             , exportLabel    = [BranchLabel MostEmergentTfIdf 2, GroupLabel MostEmergentInclusive 2]
             , exportSort     = ByHierarchy
             , exportFilter   = [ByBranchSize 2]  
@@ -165,6 +168,8 @@ instance FromJSON SeaElevation
 instance ToJSON SeaElevation
 instance FromJSON TimeUnit
 instance ToJSON TimeUnit
+instance FromJSON CliqueFilter
+instance ToJSON CliqueFilter
 instance FromJSON Clique
 instance ToJSON Clique
 instance FromJSON PhyloLabel

src/Gargantext/Core/Viz/Graph/MaxClique.hs

@@ -60,17 +60,19 @@ import Data.Set (Set)
 import Data.Set (fromList, toList, isSubsetOf)
 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
 import Gargantext.Core.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
-import Gargantext.Core.Viz.Graph.Tools (cooc2graph', Threshold)
+import Gargantext.Core.Viz.Graph.Tools (cooc2graph',cooc2graph'', Threshold)
 import Gargantext.Core.Viz.Graph.Distances (Distance)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex)
+import Gargantext.Core.Viz.AdaptativePhylo
+-- import Debug.Trace (trace)
 type Graph = Graph_Undirected
 type Neighbor = Node
 
 
 -- | getMaxCliques
 -- TODO chose distance order
-getMaxCliques :: Ord a => Distance -> Threshold -> Map (a, a) Int -> [[a]]
-getMaxCliques d t m = map fromIndices $ getMaxCliques' t m'
+getMaxCliques :: Ord a => CliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]]
+getMaxCliques f d t m = map fromIndices $ getMaxCliques' t m'
   where
     m'          = toIndex to m
     (to,from)   = createIndices m
@@ -80,7 +82,10 @@ getMaxCliques d t m = map fromIndices $ getMaxCliques' t m'
     getMaxCliques' t' n = maxCliques graph
       where
         graph = mkGraphUfromEdges (Map.keys n')
-        n'    = cooc2graph' d t' n
+        -- n'    = cooc2graph' d t' n
+        n'    = case f of ByThreshold  -> cooc2graph'  d t' n
+                          ByNeighbours -> cooc2graph'' d t' n
+
 
 maxCliques :: Graph -> [[Node]]
 maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -35,6 +35,7 @@ import qualified IGraph.Algorithms.Layout as Layout
 import qualified Data.Vector.Storable as Vec
 import qualified Data.Map  as Map
 import qualified Data.List as List
+-- import Debug.Trace (trace)
 
 type Threshold = Double
 
@@ -52,6 +53,39 @@ cooc2graph' distance threshold myCooc = distanceMap
     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 
 
+cooc2graph'' :: Ord t => Distance
+                      -> Double
+                      -> Map (t, t) Int
+                      -> Map (Index, Index) Double
+cooc2graph'' distance threshold myCooc = neighbouMap
+  where
+    (ti, _) = createIndices myCooc
+    myCooc' = toIndex ti myCooc
+    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    distanceMat = measure distance matCooc
+    neighbouMap = filterByNeighbours threshold
+                $ mat2map distanceMat
+
+
+-- Quentin
+filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
+filterByNeighbours threshold distanceMap = filteredMap
+  where 
+    indexes :: [Index]
+    indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
+    filteredMap :: Map (Index, Index) Double
+    filteredMap = Map.fromList
+                $ List.concat 
+                $ map (\idx -> 
+                          let selected = List.reverse
+                                       $ List.sortOn snd
+                                       $ Map.toList 
+                                       $ Map.filter (> 0)
+                                       $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
+                           in List.take (round threshold) selected
+                      ) indexes                 
+
+
 cooc2graph :: Distance
            -> Threshold
            -> (Map (Text, Text) Int)

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

@@ -104,7 +104,7 @@ config =
     defaultConfig { phyloName  = "Cesar et Cleopatre"
                   , phyloLevel = 2
                   , exportFilter = [ByBranchSize 0]
-                  , clique = MaxClique 0 }
+                  , clique = MaxClique 0 3 ByNeighbours }
 
 
 docs :: [Document]
@@ -134,7 +134,6 @@ actants = [ "Cleopatre"   , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV", "Ptolem
 corpus :: [(Date, Text)]
 corpus = sortOn fst [ 
   (-101,"La tutelle Cesar Caesar-III  de sa mère lui étant difficile à endurer, en septembre 101 av. J.-C., Ptolemee-X la fait assassiner et peut enfin régner presque seul puisqu'il partage le pouvoir avec son épouse Berenice-III Cléopâtre Philopator."),
-  (-101,"Ptolemee-X la fait assassiner et peut enfin régner presque seul puisqu'il partage le pouvoir avec son épouse Berenice-III Cléopâtre Philopator."),  
   (-99,"Caesar-III est questeur en 99 av. J.-C. ou 98 av. J.-C., et préteur en 92 av. J.-C.."),
   (-100,"Caius Julius Caesar-IV — dit Jules Cesar Ptolemee-X — naît vers 100 av. J.-C., il est le fils de Caius Julius Caesar-III et de Aurelia-Cotta"),
   (-85,"Caesar-III meurt à Pisae de cause naturelle en 85 av. J.-C. : selon Pline l'Ancien, il décède brusquement en mettant ses chaussures"),
@@ -155,5 +154,4 @@ corpus = sortOn fst [
   (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), 
   (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII.  Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), 
   (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), 
-  (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."),   
   (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]          
\ No newline at end of file

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

@@ -203,8 +203,8 @@ toPhyloClique phylo phyloDocs = case (clique $ getConfig phylo) of
                  $ filterClique True s (filterCliqueBySupport)
                  {- \$ traceFis "Unfiltered Fis" -}
                  phyloClique
-    MaxClique s -> filterClique True s (filterCliqueBySize)
-                 phyloClique
+    MaxClique s _ _ -> filterClique True s (filterCliqueBySize)
+                       phyloClique
     where
         -------------------------------------- 
         phyloClique :: Map (Date,Date) [PhyloClique]
@@ -216,13 +216,13 @@ toPhyloClique phylo phyloDocs = case (clique $ getConfig phylo) of
                                $ toList phyloDocs
                           fis' = fis `using` parList rdeepseq
                        in fromList fis'
-          MaxClique _ -> 
+          MaxClique _ thr filterType -> 
                       let mcl  = map (\(prd,docs) -> 
                                     let cooc = map round
                                              $ foldl sumCooc empty
                                              $ map listToMatrix 
                                              $ map (\d -> ngramsToIdx (text d) (getRoots phylo)) docs
-                                     in (prd, map (\cl -> PhyloClique cl 0 prd) $ getMaxCliques Conditional 0.001 cooc)) 
+                                     in (prd, map (\cl -> PhyloClique cl 0 prd) $ getMaxCliques filterType Conditional thr cooc)) 
                                $ toList phyloDocs
                           mcl' = mcl `using` parList rdeepseq                               
                        in fromList mcl' 

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

@@ -225,12 +225,12 @@ traceFis msg mFis = trace ( "\n" <> "-- | " <> msg <> " : " <> show (sum $ map l
 getCliqueSupport :: Clique -> Int
 getCliqueSupport unit = case unit of 
     Fis s _ -> s
-    MaxClique _ -> 0
+    MaxClique _ _ _ -> 0
 
 getCliqueSize :: Clique -> Int
 getCliqueSize unit = case unit of 
     Fis _ s -> s
-    MaxClique s -> s
+    MaxClique s _ _ -> s
 
 
 --------------