Merge branch 'dev-maxClique' into dev

package.yaml

@@ -160,6 +160,8 @@ library:
   - profunctors
   - protolude
   - pureMD5
+  - random-shuffle
+  - MonadRandom
   - SHA
   - simple-reflect
   - cereal     # (IGraph)

src/Gargantext/Prelude/Utils.hs

@@ -18,17 +18,24 @@ module Gargantext.Prelude.Utils
 import Control.Lens (view)
 import Control.Monad.Reader (MonadReader)
 import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Random.Class (MonadRandom)
 import Data.Text (Text)
 import Control.Monad.Reader (ask)
 import GHC.IO (FilePath)
 import Gargantext.Prelude
 import Gargantext.API.Settings
 import System.Random (newStdGen)
+import qualified System.Random.Shuffle as SRS
 import System.Directory (createDirectoryIfMissing)
 import qualified Data.ByteString.Lazy.Char8  as Char
 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
 import qualified Data.Text                   as Text
 
+
+shuffle :: MonadRandom m => [a] -> m [a]
+shuffle ns = SRS.shuffleM ns 
+
+
 type FolderPath = FilePath
 type FileName   = FilePath
 

src/Gargantext/Viz/Graph/FGL.hs

@@ -45,6 +45,24 @@ edges = FGL.edges
 nodes :: Graph gr => gr a b -> [Node]
 nodes = FGL.nodes
 
+------------------------------------------------------------------------
+-- | Graph Tools
+
+filterNeighbors :: Graph_Undirected -> Node -> [Node]
+filterNeighbors g n = List.nub $ neighbors g n
+
+-- Q: why not D.G.I.deg ? (Int as result)
+degree :: Graph_Undirected -> Node -> Double
+degree g n = fromIntegral $ List.length (filterNeighbors g n)
+
+vcount :: Graph_Undirected -> Double
+vcount = fromIntegral . List.length . List.nub . nodes
+
+-- | TODO tests, optim and use IGraph library, fix IO ?
+ecount :: Graph_Undirected -> Double
+ecount = fromIntegral . List.length . List.nub . edges
+
+
 ------------------------------------------------------------------
 -- | Main sugared functions
 

src/Gargantext/Viz/Graph/IGraph.hs

@@ -19,6 +19,7 @@ import Data.Serialize (Serialize)
 import Data.Singletons (SingI)
 import Gargantext.Prelude
 import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
+import IGraph.Algorithms.Clique as IAC
 import qualified IGraph as IG
 import qualified Data.List as List
 
@@ -46,10 +47,17 @@ edges = IG.edges
 
 nodes :: IG.Graph d v e -> [Node]
 nodes = IG.nodes
+------------------------------------------------------------------
+
+-- | Tools
+maximalCliques :: IG.Graph d v e -> [[Int]]
+maximalCliques g = IAC.maximalCliques g (min',max')
+  where
+    min' = 0
+    max' = 0
 
 ------------------------------------------------------------------
 -- | Main sugared functions
-
 mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
 mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
   where

src/Gargantext/Viz/Graph/MaxClique.hs

+{-| Module      : Gargantext.Viz.Graph.MaxClique
+Description : MaxCliques function
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+- First written by Bruno Gaume in Python        (see below for details)
+- Then  written by Alexandre Delanoë in Haskell (see below for details)
+
+# By Bruno Gaume:
+def fast_maximal_cliques(g):
+
+    def rec_maximal_cliques(g, subv):
+        mc = []
+        if subv == []: # stop condition
+            return [[]]
+        else :
+            for i in range(len(subv)):
+                newsubv = [j for j in subv[i+1:len(subv)]
+                                   if (j in g.neighbors(subv[i]))]
+                mci = rec_maximal_cliques(g, newsubv)
+                for x in mci:
+                    x.append(subv[i])
+                    mc.append(x)
+            return mc
+
+    def purge(clust):
+        clustset = [set(x) for x in clust]
+        new_clust = []
+        for i in range(len(clustset)):
+            ok = True
+            for j in range(len(clustset)):
+                if clustset[i].issubset(clustset[j]) and (not (len(clustset[i]) == len(clustset[j])) ):
+                    ok = False
+            if ok and (not (clustset[i] in new_clust)):
+                new_clust.append(clustset[i])
+        return [list(x) for x in new_clust]
+
+    # to optimize : rank the vertices on the degrees
+    subv = [(v.index, v.degree()) for v in g.vs()]
+    subv.sort(key = lambda z:z[1])
+    subv = [x for (x, y) in subv]
+    return purge(rec_maximal_cliques(g, subv))
+
+-}
+
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Gargantext.Viz.Graph.MaxClique
+  where
+
+import Gargantext.Prelude
+import Data.List (sortOn, nub, concat, length)
+import Data.Set (Set)
+import Data.Set (fromList, toList, isSubsetOf)
+import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
+import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
+
+
+type Graph = Graph_Undirected
+type Neighbor = Node
+
+maxCliques :: Graph -> [[Node]]
+maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax
+  where
+    ns :: [Node]
+    ns = sortOn (degree g) $ nodes g
+
+    subMaxCliques :: Graph -> [Node] -> [[Node]]
+    subMaxCliques _ []  = [[]]
+    subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
+      where
+        ns' = [n | n <- xs, elem n $ neighborsOut g' x]
+
+        add :: Node -> [[Node]] -> [[Node]]
+        add n [] = [[n]]
+        add n (m:ms) = [n:m] <> add n ms
+        -- | Note, it is same as :
+        -- add n ns = map (\m -> n : m) ns
+        -- -- (but using pattern matching and recursivity)
+        -- -- (map is redefined in fact)
+
+        -- | To be sure self is not in neighbors of self
+        -- (out to exclude the self)
+        neighborsOut :: Graph -> Node -> [Node]
+        neighborsOut g'' n = filter (/= n) $ neighbors g'' n
+
+
+    takeMax :: [[Node]] -> [[Node]]
+    takeMax = map toList
+            . purge
+            . map fromList
+            . sortOn length
+            . nub 
+      where
+        purge :: [Set Node] -> [Set Node]
+        purge [] = []
+        purge (x:xs) = x' <> purge xs
+          where
+            x' = if all (== False) (map (isSubsetOf x) xs)
+                    then [x]
+                    else []
+
+
+------------------------------------------------------------------------
+test_graph :: Graph
+-- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
+test_graph = mkGraphUfromEdges [(1,2), (3,3)]
+
+test_graph' :: Graph
+test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
+
+test_graph'' :: Graph
+test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
+
+test_graph''' :: Graph
+test_graph''' = mkGraphUfromEdges [ (4,1)
+                                  , (4,2)
+                                  , (3,1)
+                                  , (3,2)
+                                  , (2,1)
+                                  ]

src/Gargantext/Viz/Graph/Proxemy.hs

@@ -95,7 +95,11 @@ prox_markov g ns l r nf = foldl' (\m _ -> spreading g m r nf) ms path
            _    -> Map.empty
 
 
-spreading :: Graph_Undirected -> Map Node Double -> FalseReflexive -> NeighborsFilter -> Map Node Double
+spreading :: Graph_Undirected
+          -> Map Node Double
+          -> FalseReflexive
+          -> NeighborsFilter
+          -> Map Node Double
 spreading g ms r nf = Map.fromListWith (+) $ List.concat $ map pvalue (Map.keys ms)
   where
     -- TODO if list empty ...
@@ -107,22 +111,6 @@ spreading g ms r nf = Map.fromListWith (+) $ List.concat $ map pvalue (Map.keys
         neighborhood  = (nf g n) <> (if r then [n] else [])
 
 
-------------------------------------------------------------------------
--- | Graph Tools
-
-filterNeighbors :: Graph_Undirected -> Node -> [Node]
-filterNeighbors g n = List.nub $ neighbors g n
-
-degree :: Graph_Undirected -> Node -> Double
-degree g n = fromIntegral $ List.length (filterNeighbors g n)
-
-vcount :: Graph_Undirected -> Double
-vcount = fromIntegral . List.length . List.nub . nodes
-
--- | TODO tests, optim and use IGraph library, fix IO ?
-ecount :: Graph_Undirected -> Double
-ecount = fromIntegral . List.length . List.nub . edges
-
 ------------------------------------------------------------------------
 -- | Behavior tests